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FOREWORD 


This volume (II) documents the computer programs developed under 
Contract NAS3-11216. The volume was originally published in December 
1970 and contained the programs as described in report Volume I. Addi- 
tional work on the hydrodynamic analysis and computer program (in the 
areas of tip clearance and leading edge sweepback) was later conducted 
under Contract Modification 3. This additional work is reported in 
Volume III and the modified computer program is included in this revised 
issue of Volume II. 

The work was sponsored by the Lewis Research Center, National 
Aeronautics and Space Administration, Cleveland, Ohio, under the techni- 
cal direction of the Chemical Rocket Division with Mr. D. D. Scheer, 
Project Manager. Further information regarding the programs and their 
application may be obtained by contacting Mr. Scheer. 

Pratt and Whitney Aircraft's Florida Research and Development Cen- 
ter at West Palm Beach, Florida was the contractor and Mr. W. E. Young 
was the Program Manager. The following Pratt & Whitney personnel con- 
tributed to the program: 

Mr, R. E. Davis supervised the analytic effort. 

Mr. H. J. Barten, Mr. L. L. Coons, and Mr. G. G. Roberts performed 

the analytic work. 

Mr. D. R. Edmonds Jr, and Mr. J. A. Scheurenbrand did the computer 

programming. 
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SECTION I 


INTRODUCTION 

The computer programs that were developed as a result of the work 
reported in Volumes I and III are listed in this volume. Three computer 
programs are included: 

1) Hydrodynamic Computer Program - This program calculates the 
internal flow, blade loading, and performance of an inducer 
under noncavitating and cavitating conditions. The basic flow 
analysis uses a mean streamline, two dimensional, axisymmetric 
model. It is assumed that all cavitation is contained in a 
cavity on +he blade suction surface and, because the vapor 
cavity merely displaces liquid, it is considered that the 
actual blade can be replaced by a pseudo blade consisting of 
the real blade plus the cavity. The analysis includes viscous 
effects and the program input provides for leading edge sweep- 
back and tip clearance, 

2) Stress Computer Program - The stress program calculates stresses 
and deflections of the inducer blade which result from blade 
pressure loading and centrifugal force. The analysis uses the 
finite element matrix displacement method where the blade is 
replaced by contiguous polygonal elastic elements of finite 
size which are joined at their vertices or nodes. The program 
input provides for blade lean and for variable thickness blades, 

3) Vibration Computer Program - The vibration program calculates 
blade natural frequencies and the distribution of relative 
deflections and stresses for each resonance. This program is 
a finite element analysis which uses many of the same subrou- 
tines as the stress program. 

Input and output descriptions, and a sample case are included for each 
program. 

The stress and vibration programs are identical to the listings 
given in the original issue of this volume. The hydrodynamic analysis 
has been modified as reported in Volume III and the program changes are 
included in this revised issue of Volume II. 
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SECTION II 

HYDRODYNAMIC COMPUTER PROGRAM (PWA 6091) 


A. GENERAL 

The hydrodynamic computer program predicts internal flow conditions 
and blade pressure loadings within an inducer. 

The basic flow analysis uses a mean streamline, two-dimensional, 
meridional flow model. It is assumed that average flow conditions in 
the blade*- to-blade space can be represented on a meridional surface. 

A two-dimensional streamline balancing analysis is then used to satisfy 
radial equilibrium and establish mean velocities, pressures, and flow 
angles. The program also employs a deviation model to calculate flow 
conditions downstream of the inducer. Inducer inlet and exit conditions 
are then integrated to obtain predictions of performance. 

The program requires approximately 180,000 bytes of core (165,000 
bytes program and 15,000 bytes buffer) on an IBM 370 Model 165 Computer* 
Computer language is Fortran IV-G Release 1.1. Approximate running time 
for a typical case (one set flow conditions) with tip clearance is 
2 minutes. 

B. INPUT DESCRIPTION 

The hydrodynamic computer program input can be divided into two 
parts : 

1. A geometric description of the inducer; and 

2. A description of the inducer operating flow parameters. More 
than one set of. flow parameters may be input for a given 
inducer geometry. 

Unless otherwise specified, data may be input in any consistent set 
of units. The same units must be used for force and mass. Output will 
correspond to the input units used. Several examples are listed below. 

Input Output 


Force 

Mass 

Length 

Velocity 

Pressure 

lb 

lb 

ft 

ft/sec 

ib/ft 2 

lb 

lb 

in. 

in. /sec 

lb/in. ^ 

gram 

gram 

meter 

meter/sec 

gram/meter 


Input data to be written on each card are described below. ,f F H 
format data should be left adjusted in the column field and should 
contain a decimal point. "I" format data should be right adjusted and 
should not contain a decimal point. 
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Columns 


Variable 

Format 

Card 1 

Title 

Card 


1-80 


Job Identification data 

20A4 

Card 2 

General Geometry 


1-5 

NX 

Number of streamlines to be considered 
Maximum of 15 

15 

6-10 

NJ 

Number of axial stations to be considered 
Maximum of 60 

15 

11-15 

NB 

Number of inducer blades 

15 

16-20 

CASES 

Number of flow conditions 

15 

21-35 

G 

Gravitational constant 

F15.5 

36-45 

ALPWH 

Hub leading edge wedge angle, degrees 

F10.4 

46-55 

ALPWT 

Tip leading edge wedge angle, degrees 

fio.4 

56-63 

CBHR 

Tip clearance to blade height ratio, may 
be zero if tip clearance analysis is not 
required. 

F10.4 

Card 3 

Geometry at Each Axial Station (NJ Cards) 


1-10 

Z 

Axial dimension from the station to the 

fio.4 


leading . edge ‘ Stations ’ spacing may be 
varied to provide fine resolution in 
areas where flow conditions are expected 
to change rapidly. 


11-20 

RH 

Hub radius 


F10.4 

21-30 

RT 

Tip radius 


F10.4 

31-40 

BHS 

Hub blade angle, degrees from 

tangential 

fio.4 

41-50 

BTS 

Tip blade angle, degrees from 

tangential 

fio.4 

51-60 

TT 

Blade tip thickness 


F10.4 

61-70 

TA 

Blade taper angle, degrees 


F10.4 

Card 4 

+NJ Leading Edge Shape 



1-40 

Zq ,Z 1 
^2 1 ^3 

Coefficients of the third degree quad- 
ratic equation which defines the leading 
edge curvature as projected on the 
meridional plane 

4F10.4 
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Columns 


Variable 

Format 

Card 3 

+NJ Fluid 

Properties, Speed, & Print Option 


1-10 

RHO 

Specific weight 

F10.4 

11-20 

MU 

Kinematic viscosity 

F10.4 

21-30 

PSAT 

Saturation pressure 

F10. 4 

31-40 

SN 

Rotating speed, rev/sec 

F10.4 

4-1-50 

LOADOP 

0 if no blade loading data desired 

1 if blade loading data is desired 
Automatically 1 if CBHR is positive 

110 

Card 6 

+NJ Inlet 

Flow Conditions at Each Streamline (NI 

Cards) 

1-10 

PO 

Relative inlet total pressure 

F10.0 

11-20 

V A 

Inlet axial velocity 

F10.0 

21-30 

ALPHI 

Inlet absolute flow angle, degrees 
from tangential 

F10.0 

For more than 1 set of flow conditions (CASES > 1), repeat 
cards (5+NJ) and (6+NJ) 



C. OUTPUT DESCRIPTION 

The output of the program is in the following seven parts. Parts 3 
thru 7 are printed twice if CBHR is a positive number, first for zero 
and then for the specified tip clearance. 

1. Geometry 

The input geometry is printed out for reference. Also solidity at 
the inlet tip is calculated and printed out. 

2. Fluid Properties and Inlet Flow Conditions 

The input fluid properties (Card 5) and the input inlet flow 
conditions (Cards 6 thru NI) are printed. 

3. Inlet Conditions 

The above flow conditions and the following additional inlet 
conditions are listed for each streamtube. 

I Streamtube number 

ALPHA Absolute flow angle, degrees from tangential 
R Streamtube radius 

BETA Relative flow angle, degrees from tangential 
Q Volumetric flow 

K Cavitation number, k 

W Relative velocity 

U Inducer tangential velocity 
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PO Absolute total pressure 

V Absolute velocity 

PREL Relative total pressure 

VM Meridional velocity 

P Static pressure 

VU Absolute tangential velocity 

PHI Mass averaged inlet flow coefficient, <t> 

NPSH Mass averaged net positive suction head 
THOMA Cavitation parameter 

VT Inducer tip speed 

PT Mass averaged total pressure 

4. Internal Flow Conditions 

The following are listed for each axial station 
J Station number 

Z Axial dimension to station 

ITE Number of iterations required to obtain radial pressure 
equilibrium. 

The following are listed for each streamtube at each axial station. 
I Streamtube number 

P Static pressure 

BETA Relative flow angle, degrees from tangential 

ALPHA Absolute flow angle, degrees from tangential 
RST Streamline radius 

PREL Relative total pressure of the core flow 
BETA* Blade angle, degrees from tangential 
ETA Efficiency 

PCR Ratio (RST-RH) / (RT-RH) 
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POREL Relative total pressure (mass-averaged) 

DEV Deviation angle, degrees 

W Relative velocity 

R Streamtube radius 

PT Absolute total pressure 

DLB* Vapor cavity slope angle, degrees 

U Inducer tangential velocity 

TAU Blade tangential spacing 

M* Distance along blade 

XMTH Momentum thickness 

V Absolute velocity 

THK Normal blade thickness 
BN Normal cavity height 

DEL* Boundary layer displacement thickness 
VU Absolute tangential velocity 
B Tangential cavity height 

PCB Ratio of tangential cavity height to blade tangential 

spacing, B/TAU 

HSF Ratio DEL* /XMTH 

VM Meridional velocity 

5 * Exit Conditions 

The following are listed for each streamtube at an axial station 
downstream of the inducer. 

I Streamtube number 

ALPHA Absolute flow angle, degrees from tangential 
R Radius of streamtube 

BETA Relative flow angle, degrees from tangential 
DEV Deviation angle 
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V Absolute velocity 

H Head rise 

VM Meridional velocity 

P Static pressure 

VU Absolute tangential velocity 

PT Total pressure 

WU Relative tangential velocity 

ETA Efficiency 

W Relative velocity 

6. Performance Parameters 

The following listed parameters represent the mass averaged 
performance of the inducer. 

NPSH Net positive suction head 

PHI Flow coefficient 

PSI Head coefficient 

H Head rise 

HI Ideal head rise 

RN Reynolds number 

ETA Efficiency 

SS Specific speed 

01 Volumetric flow 

CVOL Total blade suction surface cavity volume (all blades) 
PSI IDEAL Ideal head coefficient 

PSI LOSS Head loss coefficient 

7. Blade Loading Data 

This data is listed if "LOADOP" is input as 1. The following 
sire listed for each axial station. 

J Station number 

Z Axial dimension to station 

Z/ZT Ratio of axial length to total axial length 



The following are listed for each streamtube at each axial station. 
I Streamtube number 

R Streamtube radius 

PS Static pressure on blade suction surface 

PP Static pressure on blade pressure surface 

WS Relative velocity along blade suction surface 

WP Relative velocity along blade pressure surface 

DPB Normal pressure difference across blade 
PSIS Suction surface static head coefficient 
PSIP Pressure surface static head coefficient 
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D. HYDRODYNAMIC COMPUTER PROGRAM 
Sample Case (Noncavitating Flow) 
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Printout for Stations J=4 thru J=23 is omitted for Brevity 
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E. HYDRODYNAMIC COMPUTER PROGRAM LISTING 


3k 



PAGE 


11/01/72 SLIST 


C ************************************************************** 
C * INDUCER HYDRODYNAMIC PROGRAM * 

C * * 

c ************************************************************** 

C F.R.D.C. 

REAL Ll»LOW,Ml »M2,M3,M4*N1,N2»N3,N4,L0WL1M 
REAL ML »M»K »MP »NU »MU ,MSTR »NPSH »MOM »MOMP 
INTEGER CASE »CAsES 


LOGICAL ERROR 
D I M E N S I 0 
1 RIN (15), 

N 

BSIN 

( 15) , 

TCBS I 

< 15 j * 

WIN 

(15) 

2 


PRELI 

( 15 ) » 

BSEX 

(15) , 

WJ1 

( 15) » 

WEX 

< 15) 

3 


WNJ 

(15) » 

DBS 

( 15) * 

REX 

(15), 

VEX 

(15) 

4 


DBSP 

( 15 ) ♦ 

PORELP( 15) » 

RVU 

(15)* 

MOM 

(15) 

5 


A 

(15) » 

AP 

(15) * 

MOMP 

( 15) • 

PCR 

(15) 

6 


SI 

(15) » 

SIB 

(15) • 

R 

(15) » 

M 

(15) 

7 


DM 

( 15 ) » 

H 1 0 

(15) * 

BETA 

( 15) » 

W 

( 15) 

8 


B 

( 15) » 

PREL 

( 15) » 

RP 

(15) » 

BETAP 

(15) 

9 


SIP 

( 15 ) » 

MP 

( 15) » 

TT 

(60 ) ♦ 

BP 

(15) 

1 


PRELP 

( 15 ) , 

DY 

( 15) » 

DYP 

( 15 ) » 

BETAS 

(15) 

2 


TAU 

( 15 ) » 

ZBL 

(15)* 

PX 

( 15) * 

TA 

(60) 

3 


E 

(15 ) » 

PCR 1 

( 15) » 

TAUP 

( 15) » 

RSTL 

(15) 

4 


SIS 

( 15 ) ♦ 

SISP 

(15) * 

WP 

(15) . 

PXP 

(15) 

5 


RSTS 

( 15) ♦ 

PRELEX( 15) » 

ESV 

(15) * 

ITB 

( 15) 

6 


POREL 

( 15 ) ♦ 

DBDM 

(15) ♦ 

DWDM 

< 15) ♦ 

HSF 

(15) 

7 


XMTH 

( 15 ) , 

HSFP 

(15) • 

XMTHP 

( 15) * 

PO 

(15) 

8 


VA 

( 15) , 

ALPHI 

(15)* 

Q 

( 15 > ♦ 

HO 

< 15 ) 

9 


XIOI 

(15) » 

XMTH I 

( 15 ) ♦ 

BIN 

(15) ♦ 

TERM1 

(15) 

D 

1 

I 

MEN 

TERM2 

S I 0 
( 15 ) » 

N 

BTS 

(60) » 

BETASP ( 15 > » 

T 

(15) 

2 


TP 

( 15 ) * 

SBS 

(15) * 

TBS 

(15), 

CBS 

(15) 

3 


TITLE 

(20) * 

CSB 

(15) ♦ 

PCBB 

( 15) * 

DELW 

( 15) 

4 


Z 

(60) » 

RH 

(60) * 

RT 

(60 ) » 

BHS 

(60) 

D 

1 

I 

MEN 

TCBS 

S I 0 
(60*15) 

N 

, ML (60 

• 15) » 

BL (60 

♦ 15) ♦ 

PRELL 

(60, 

2 PXL 

DIMENSION 
DIMENSION 

(60,15) * DPBN ( 60 *15) » 
DC ( 1 5 ) » DCP ( 15 ) 

WNC (60,15 ) *DBTC (60*1 

RL (60*15) 

5 ) * WPX (60*15 ) 

*WSX(60 

*15) 


1 PSX ( 60 ♦ 1 5 ) *PPX ( 60 » 15 ) *WVX(60»15.J *TAUVx.< 60*15 ) ,DMVX(60*15) » 

2 DYX t 60 * 1 5 ) »BET ASX (60*15) » FUNC ( 60 ) * YOUT ( 60 ) *TGIF( 4) *XC0DM(20) 

3 YFLR ( 20 ) 

DATA XCODM / .0 1 * .02 » • 03 * .04 » ,. 05 * .06 ♦ « 07 ♦ *08 » • 09* • 10 » , 12 ♦ « 14* • 

1 « 1 8 * « 2 0 * « 2 5 * « 3 0 » • 3 5 * * 40 / * 

2 YFLR / *007, ,007*. 007*. 008*. 01*. 014*. 025**041 ,. 054*. 06»« 

3 . 085**094 * • 10 » .107 * .123* • 134, . 143 *. 152/ 


C 

C 

C 

1 


CALL ZERO ( N I » T G I F { 4 ) ) 

***** INPUT ***** 

READ(5»2,END=999) TITLE 
WR I T E (6*4 ) TITLE 

READ (5 *3) N I ♦ NJ »NB *CASES ,G» 
WRITE (6, 5) NI »NJ»N8»CASES»G »CBHR 


ALPWH* ALPWT* CBHR 


OOOOOOIO 
00000020 
00000030 
00000040 
00000050 
00000060 
00000070 
00000080 
00000090 
00000100 
00000110 
00000120 
00000130 
00000140 
00000150 
00000160 
00000170 
00000180 
00000190 
00000200 
00000210 
00000220 
00000230 
00000240 
00000250 
00000260 
00000270 
00000280 
00000290 
00000300 
00000310 
00000320 
00000330 
00000340 
00000350 
00000360 
00000370 
00000380 
00000390 
, 00000400 

00000410 
16* 00000420 
00000430 
075*00000440 
00000450 
00000460 
00000470 
00000480 
00000490 
00000500 
00000510 
00000520 
00000530 
00000540 
00000550 
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C BLADE HUB AND TIP DESCRIPTION 

C 

WRITE(6»6) 

READ (5 *7) (2(1), RH ( I) ,RT(I), BHS < I ) » BTS(I) 
1 I = l.NJ ) 

WR I TE I 6 * 8 ) ( I ,Z( I ) »RH( I J »RT ( I > »BHS ( I > »BTS(I) 

1 I = 1 » NJ ) 

DO 88 J s 1 ♦ NJ 

BHS(J) - BHS(J) / 57.2958 
BTS(J) = BTS(J) / 57.2958 
88 CONTINUE 


TT( I) * T A ( I ) ♦ 
TT< I ) . TA« I ) ♦ 


C 

C COEFFICIENTS FOR SWEPT LEADING EDGE 
READ ( 5 *6091 ) 20,21*22*23 
C 

ALPWT = ALPWT / 57.29577 

ALPWH = ALPWH / 57.29577 

BTSB = ( BTS(1> + BTS(NJ)) / 2.0 

C2 = 6.2832 / NB 

XYZ = ZO + Zl*RT ( 1 ) + Z2*RT ( 1 ) **2 + Z3*RT(1)**3 
SIG = ( Z(NJ) -XYZ)/ ( C2* RT ( 1 ) * SINIBTSB) ) 

C 

I F ( CBHR .EQ. 0.0 ) GO TO 770 
CLEAR = CBHR * (RT(1> - RH ( 1 ) ) 

CODM = CLEAR / (<2(NJ) - 211)1 * SIN (BTSB)) 

CALL NEWGG (19. CODM, FLR » XCODM* YFLR ) 

FLR = FLR * 3.141592 
770 WR I TE ( 6 * 760 5 20»Z1»Z2»Z3 

760 FORMAT ( // * SWEPT LEADING EDGE COEFFI C I ENTS* / ' ZO* • »F10 • 5/ • 21= » » 

1 F10. 5/' Z2= » .F10.5/* Z3= ’ » FI 0.5//) 

ALPH = ALPWH * 57.29578 
ALPT = ALPWT * 57.29578 
WR I TE ( 6 *761 ) SIG.ALPH.ALPT 

761 FORMAT (T9* ’SOLIDITY ' »T24. ’ALPWH’ *T38 * • ALPWT • /3F15.7) 

C 

C ***** END OF INPUT ***** 

C 

C OPERATING CONDITIONS 

C 

CASE = 1 

20 READ (5*17* END = 999 ) RHO, MU, PSAT* SN* LOADOP 
I F ( CBHR .EQ. 0.0 ) GO TO 775 
LOADOP = 1 

WRITE (6 *785 ) CASE »RHO» MU » PSAT »SN» LOADOP* FLR 
GO TO 790 

775 WRITE (6*22) CASE* RHO* MU, PSAT, SN , LOADOP 
790 READ (5,19) (PO(I)» VA ( 1 ) » ALPHI ( I) » I = 1*NI) 

WRITE (6,23) (PO(I)» VA ( I) , ALPH I ( I ) » 1=1, Nil 
NREV = 0 

926 NREV = NREV + 1 
KILL = 0 
C 

c INTERNAL PROGRAM CONSTANTS 

C 

NXX I = NI - 1 
CVOL = 0.0 
PI = 3.141592 


00000560 

00000570 

00000580 

00000590 

00000600 

00000610 

00000620 

00000630 

00000640 

00000650 

00000660 

00000670 

00000680 

00000690 

00000700 

00000710 

00000720 

00000730 

00000740 

00000750 

00000760 

00000770 

00000780 

00000790 

00000800 

00000810 

00000820 

00000830 

00000840 

00000850 

00000860 

00000870 

00000880 

00000890 

00000900 

00000910 

00000920 

00000930 

00000940 

00000950 

00000960 

00000970 

00000980 

00000990 

00001000 

00001010 

00001020 

00001030 

00001040 

00001050 

00001060 

00001070 

00001080 

00001090 

00001100 

00001110 

00001120 
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uuuuuu u u u 


NU ■ MU / RHO 
OMEGA = SN * 6,2832 
Cl * RHO /2.0 / G 
C3 = Cl * OMEGA**2 
VT = OMEGA * RT ( 1 ) 

INLET ROUTINE 
{ UPSTREAM ) 

CONSTANT PARAMETERS 

DZ = 0.0 

DR * RT(1) - RH ( 1 ) 

DR2 « ( RT ( 1 ) **2 - RH ( 1 ) **2 ) / Nl 
CE = 0.284 / SIG **0.5 

SLOP * ( RT(1)*TAN(BTS(1) )- RHU) *TAN(BHS{ 1) ) )/ DR 

SIT * ATAN ( ( R T ( 2 ) - RT ( 1 K / < Z <2 ) - Z (1) > > 

SIH = ATAN( (RH(2 > - RH( 1 ) ) / ( Z (2 ) - Z ( 1 ) 1 ) 

DSI = SIT - SIH 
DELS * 0.0 

ZP = 2(1) - .001*( Z ( 2 > - z ( 1 I ) 

RSTP a RHU.) 

DRZE = ( RT ( N J ) **2 - RH(NJ)**2) / NI 
RSTEP = RH(NJ) 

Ql = 0. 

ZZ1 a 0. 

ZZ2 a 0. 

WRITE (6*30) 

VARIABLE PARAMETERS 

DO 40 I a i , NI 

RSTE a SORT ( RSTEP**2 + DRZE) 

rst a sort ( rstp**2 + dr2 ) 

RSTS(I) = RST 

PCR ( I ) a { rst - RH( 1 > ) / DR 
DY( I ) = RST - RSTP 
R ( I ) a (RSTP + RST ) / 2.0 
TAU ( I ) = C2 * R( I ) 

RTNB = RT ( 1 ) * TAN(BTSU) > - SLOP * C RT 1 2 ) “ R(I) ) 
BETAS ( I ) = ATAN < RTNB / R C I ) ) 

SKI) = SIH + ( R ( I ) - RH ( 1 ) ) / DR * DS I 
SIS ( I ) * SHI) 

S I B ( I ) = SKI) 

A«n = TAU (I) * DY(I) * COSCSId)) 

U a OMEGA * R ( I ) 

ALPHA = ALPH III) / 57.29578 
VM a vA(I ) 

V = VM / S I N ( ALPHA ) 

VU = V * COS (ALPHA ) 

WU = U - VU 

BETA (I ) a ATAN( VM / WU ) 

XIOI ( I ) = BETAS ( I ) - BETA ( I ) 

W(I ) = VM / SIN (BETA ( I ) ) 

PX ( I ) = PO( I ) - Cl * V**2 
QD a Cl * Wd ) **2 


00001130 
00001140 
00001150 
00001160 
00001170 
00001180 
00001190 
00001200 
00001210 
00001220 
00001230 
00001240 
00001250 
00001260 
00001270 
00001280 
00001290 
00001300 
00001310 
00001320 
00001330 
00001340 
00001350 
00001360 
00001370 
00001380 
00001390 
00001400 
00001410 
00001420 
00001430 
00001440 
00001450 
00001460 
00001470 
00001480 
00001490 
00001500 
000015 10 
00001520 
00001530 
00001540 
00001550 
00001560 
00001570 
00001580 
00001590 
00001600 
00001610 
00001620 
00001630 
00001640 
00001650 
00001660 
00001670 
00001680 
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n no 


PRELt I) = PX(I)+QD 
K = ( PX ( I ) “PS AT ) / QD 

HlO ( I > = U * VU / G 
HO ( I ) = PCX I) / RHO 
0(11 * VM * At I ) 

QI * QI + Q(I) * FLOAT(NB) 

ZZ1 = ZZ1 + VM 

112 = ZZ2 + PO(I) * Q( I 1 

DELWtn * 0.0 

E( II = 0. 

T (I 1 = 0 . 

B< I 1 = 0. 

BLtl.IJ * 0. 

Ml I ) = 0.0 

DC < I ) * 0.0 
DM t I ) * 0.0 
HSF(I) = 1 • A 

XMTH< I 1=0.278 * SORT ( NU / Will ) 
ZBL ( I 1 = 0.0 
F = 1.0 

XMTHl(I) = XMTH(I) 

B I N < I 1 = BETA( I 1 

MOMt I )=PX( I )*A( I ) * SI N ( BET AS ( I 1 ) 
1 (II) 

T CBS I < I 1 = T AU Cl) * COS( BET AS (I 1 

RVUt I 1 ■ R( I 1 * VU 

DBS ( I) = XIOI ( I 1 

RlNt I 1 = Rt I 1 

BSIN (I 1 = BET AS ( I 1 

W I N ( I 1 * W t I 1 

PRELI ( I 1 = PRELt I 1 

RSTP = RST 

DCTPD = DCTF 

BETADG = BETA < I 1 * 57.2958 
ALPHDG = ALPHA * 57.29578 
WRITE (6.41) I. R(I) .Qtl 1 tWU 1 »F 
1 <» U» Vt VM. VU 
40 CONTINUE 

MAIN PROGRAM 


00001690 

00001700 

00001710 

00001720 

00001730 

00001740 

00001750 

00001760 

00001770 

00001780 

00001790 

00001800 

00001810 

00001820 

00001830 

00001840 

00001850 

00001860 

00001870 

00001880 

00001890 

00001900 

+ 2.0 * Cl * Q(I) *W( I )*COS( XIOI 000019 10 

00001920 

00001930 

00001940 

00001950 

00001960 

00001970 

00001980 

00001990 

00002000 

00002010 

00002020 

00002030 

I 1 .PRELt I ) »PX( I 1 .ALPHDG. BETADG. 00002040 

00002050 

00002060 

00002070 

00002080 

00002090 


PH = ZZ1 / NI / VT 
PHCRT = .50 * BTS(l) 

IFtPH .GT. PHCRT) G0T047327 

47328 FORMAT (/////* FLOW COEFF I Cl ENT = • »F10 • 5 .3X . ' AND 

1 1 T I CAL FLOW = • .F10.5 ) 

WRITE <6.4732 8) PH .PHCRT 
GOT 04501 
47327 CONTINUE 

PT = ZZ2 / QI * FLOAT ( NB ) 

NPSH = < PT “ PSAT ) / RHO 

XK.TIP * 2»*G*NPSH / VT**2 / (l.+PH**2) - PH**2 / (1 
THOMA * 2.0 * G * NPSH / VT**2 
WRITE ( 6 . 709 0) PH .NPSH » THOMA. VT »PT.X<T IP 
PTU = PT 
DB = 0.0 
FD * 0.0 


IS LESS THAN 


. +PH**2 ) 


00002100 
00002 110 
00002120 
CR00002 130 
00002140 
00002150 
00002160 
00002170 
00002180 
00002190 
00002200 
00002210 
00002220 
00002230 
00002240 
00002250 
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AV = 0.0 

CGAM * 0.0 

GAM * 0.0 

PP = 0.0 

PS = 0.0 

VI = 0.0 

XLAM = 0.0 

DO 300 J = 1 ♦ NJ 

J-STATION CONSTANT PARAMETERS 

252 PCRDL1 * 0.01 / NI 
ETOL = .10 

SMH *0.0 
SMH I * 0.0 
D2E * Z ( NJ ) - Z<J> 

IF ( J .NE. 1 ) ZP * Z(J - 1 ) 

DZ * ZU) - ZP 
DR = RT « J ) - RH ( J ) 

SLOP * ( RT< J)*TAN(BTS( J) )- RH ( J ) *TAN ( BHS < J ) ) ) / DR 
IF ( J .EQ. 1 ) GO TO 44 
ZZ5 = pcrdli*dr/dz 
IF ( ZZ5 .LE. 0.01 ) GO TO 44 
PCRDL1 = 0.01 * DZ/DR 
44 CONTINUE 

PCRDL * PCRDL1 

RESET INITIAL VALUES 

DO 125 1=1* NI 

MP ( I ) - M ( I ) 

RSTL ( I > * RSTS ( I ) 

RP ( I ) * R( I ) 

3ETASP ( I ) =BET AS ( I ) 

TP< I 1 = T C I ) 

TAUPU ) * T AU ( I ) 

AP ( I ) = A< I) 

DYP( I ) = DY ( I) 

S I P < I ) = SI(I) 

SISP ( I ) * SIS (I ) 

WP( I ) = W( I ) 

BETAPt I ) = BETA! I ) 

PXP< I ) = PX Cl) 

HSFP ( I ) = HSF ( I ) 

XMThP( I ) * XMTH< I ) 

MOMP (I ) * MOM ( I ) 

DBSPH ) = DBS ( I ) 

DBTC ( 1*1) = 0. 

WNC(l.I) = 0. 

BP ( I ) = BID 

DCP ( I ) = DC ( I ) 

125 PRELPU ) * PREL ( I ) 

C START STREAMLINE ITERATION 

C 

DO 130 ITE = 1 » 100 


00002260 

00002270 

00002280 

00002290 

00002300 

00002310 

00002320 

00002330 

00002340 

00002350 

00002360 

00002370 

00002380 

00002390 

00002400 

00002410 

00002420 

00002430 

00002440 

00002450 

00002460 

00002470 

00002480 

00002490 

00002500 

00002510 

00002520 

00002530 

00002540 

00002550 

00002560 

00002570 

00002580 

00002590 

00002600 

00002610 

00002620 

00002630 

00002640 

00002650 

00002660 

00002670 

00002680 

00002690 

00002700 

00002710 

00002720 

00002730 

00002740 

00002750 

00002760 

00002770 

00002780 

00002790 

00002800 

00002810 
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ERROR = .FALSE* 

IF C 1TE «GE. 25 .AND. ITE « LE « 50) PCRDL = 0.1 * PCRDL1 
I F ( ITE .GT. 50 ) PCRDL = 0.01 * PCRDL1 
SME2 * 0.0 
RSTP * RH(J) 

DO 131 I = 1 * N I 
RST « RHIJ) + PCR ( I) * DR 
SISU) * ATAN (( RST - RSTL < I ) ) / D2 ) 

IF < J .EG. 1 ) SIS(I) = SISP(I) 

RST S ( I ) = RST 
DY(I) = RST - RSTP 
DYX(J.I) = DY(I) 

RII) = ( RSTP + RST) / 2.0 
RL ( J » I ) * R ( I ) 

ZLE =Z0 + Z1*R ( I ) + Z2*R ( I ) **Z + Z3*R(I)**3 
DZLE = ZLE - Z(J) 

U = OMEGA * R ( I ) 

RSTP = RST 

RB * ( RP ( I ) + R ( I ) ) / 2.0 

RTNB = RT ( J ) *TAN ( BTS ( J ) ) - SLOP*(RT(J> -RII) ) 

BETAS(I) = ATAN ( RTNB / R(I) ) 

BETASX ( J»I ) = BETASU ) 

SBS ( I ) - SIN (BETAS (I ) ) 

TBS ( I)= TAN ( BETAS ( I ) ) 

CBS ( I ) = COS (BETAS ( I ) ) 

P0WER2 * -DZE * NB /2.0/ R C I > /(SBS(D) 

I F ( J .GT. NJ) GO TO 44444 

T ( I ) = TT ( J ) + T A ( J ) / 57.3 * < RT(J)- R t I ) > 

BETA SB = ( BETAS ( I ) + BETASP ( I ))* 0.5 
SBSB a 5IN< BET A5B ) 

SKI) = ATAN ( ( R ( I ) - RP(I))/DZ) 

I F ( J .EQ.l ) SI ( I )= SIP( I ) 

SIfl( I >= ,5*( SI(I) + SIP ( I ) ) 

CS3 ( I ) a COS ( SI B ( I ) ) 

GO TO 135 

SET VALUES FOR EXIT STATION 

44444 BSEX(I) a BETAS ( I ) 

SI(I) = 0.0 
SIB ( I ) a o.O 
T ( I ) a 0.0 
REX ( I ) a R< n 
GO TO 126 

135 DM ( I ) = DZ / CSB(I> / SBSB 
DMVX ( J * I ) = DM ( I ) 

DMBaDM(I) 

I F (DZLE .LT. 0. .AND. ZLE .GT. ZP) DMB-DM ( I ) *(-DZLE/DZ) 
IF(DZLE .GT. 0.) DMB*0 • 

M ( I ) a MP( I )+ DMB 
I F ( DZLE .GE. 0 • ) M ( I ) =0 • 

ALW aALPWT - ( RT ( J ) - R ( I ) ) / ( R T < J ) -RH{J)) *(ALPWT - ALPWH ) 
TLE * MID * TAN(ALW) * COS(SKI)) 

I F ( T LE .LT. T ( I ) ) T( I ) = TLE 

T CBS ( J * I ) = ( C2 *R(I) -T ( I ) / SBS ( I ) ) * CBS(I) 

I F (DZLE .GT. 0) T(I)=0.0 

TAU(I) a C2 * R ( I ) - Til) / SBS ( I ) 


00002820 

00002830 

00002840 

00002850 


00002860 

00002870 

00002880 

00002890 

00002900 

00002910 

00002920 


00002930 
000029 40 
00002950 
00002960 
00002970 
00002980 
00002990 
00003000 
00003010 
00003020 
00003030 
00003040 
00003050 
00003060 
00003070 
00003080 
00003090 
00003100 
00003110 
00003120 
00003130 
00003140 
00003150 
00003160 
00003170 
00003180 
00003190 


00003200 

00003210 

00003220 

00003230 

00003240 

00003250 

00003260 

00003270 

00003280 

00003290 

00003300 

00003310 


00003320 

00003330 

00003340 

00003350 

00003360 

00003370 

00003380 
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n n n n n n non 


TAUVX ( J * 1 ) = T AU ( I ) 

ML ( J » I ) = MU) 

OPDMP = 0.0 

IF ( DZLE .GT. 0) GO TO 1248 

START CAVITY ITERATION 

DBSSAV « DBS ( I ) 

ITB(I) * 1 

I F ( DBSP(I) .GT. (0.10 * BET ASP( I ) ) ) GO TO 140 

DBS ( I ) * 0.0 

IF(DELW(I) .GT. 0.0 ) GO TO 791 
IF (PCBBU) .GT. 0. .AND. PCBBU ) .LE. 0.05 > 

1 DELW(I) = (-5.389049E 04) # PCBB(I)**3 + (2.853374E 04) * 

2 PCBBU >**2 + ( -2 • 984396E 03) * PCBBU ) + 90.04968 

IF ( PCBBU) .GT. 0.05 .AND. PCBBU) .LE. 0.069 ) 

1 DELWU) = (-5.706232E 10) * PCBBU )**8 + (3.597064E 09) 

2 * PCBBU )**7 + ( 2 • 303375E 08 ) * PCBB( I )**6 + 

3 (-3.853306E 06) * PCBB( I ) **5 + ( 1.692314E 05) * PCBBU) 

4 **4 + (-8.575639E 04) * PCBBU )**3 + (-6.183219E 02) 

5 * PCBB ( I ) **2 + (-2.479463E 01) * PCBB(I) + 14.903 

IF ( PCBBU) .GE. .069 ) DELWU ) = 2.902 -10.4651* PCBBU) 

IF ( PCBBU) .GE. .155 ) DELWU) = 1.28 
DELWU) * DELWU) / 57.295 
79 1 TDW = T AN ( DELWU) ) 

CALCULATE CAVITY HEIGHT. 

BII) = BP( I ) - DZ*TDW/SBSl I )**2 
1 /U.O + TDW/TBS ( I ) ) 

IF (BII) .LT. 0.0 ) BID s 0.0 
GO TO 1248 
140 CONTINUE 

DBSB * 0.5 * (DBS (I) + DBSPI I ) ) 

IFIZLE .GE. ZP) DBSB=DBS ( I ) 

DBr DMB # SIN (DBSB) /SINIBETASB - DBSB) 

B(I ) = BP ( I ) + DB 
PCBBU) = BID / TAUU) 

I F ( DZLE .EQ. 0.0 ) BII) * 0,0 
1248 BL ( J . I ) =B ( I ) 

TAUL= TAU ( I ) -BID 
ZZ1 = 2.0 

I F ( B ( I ) .GT. 0.0) ZZ1 = 1.0 

ZZ2 = ZZ1 * DELS * DY ( I ) * COS(SIU)) / SBS(I) 

IF (I .EQ. 1 .OR, I , EQ. NI) ZZ2 * ZZ2 + DELS * (TAUL - ZZ1 * DELS 
1 / SBS I I ) > 

A(I) = DY(I) * TAUL * COS (SKI)) 

VM = 0(1) / ( A ( I ) - ZZ2 ) 

I F < DZLE .GE. 0.) BETA (I ) =AT AN ( VM/ ( R(I > *OMEGA-RVU ( I ) / R( I) ) ) 

EXIT DEVIATION 
DEL2 = 0.0 

I F ( POWER2 .LT. -100. ) GO TO 1250 
DELE = ( BETASU ) - BIN( I ) ) * CE 

DEL2 = DELE * EXP < POWER2 ) / ( 1- DELE * (1- EXP (POWER 2) ) / TAN 


00003390 

00003400 

00003410 

00003420 

00003430 

00003440 

00003450 

00003460 

00003470 

00003480 

00003490 

00003500 

00003510 

00003520 

00003530 

00003540 

00003550 

00003560 

00003570 

00003580 

00003590 

00003600 

00003610 

00003620 

00003630 

00003640 

00003650 

00003660 

00003670 

00003680 

00003690 

00003700 

00003710 

00003720 

00003730 

00003740 

00003750 

00003760 

00003770 

00003780 

00003790 

00003800 

00003810 

00003820 

00003830 

00003840 

00003850 

00003860 

00003870 

00003880 

00003890 

00003900 

00003910 

00003920 

00003930 

00003940 


41 



1 (BET AS ( I ) M 

c 

C FLUID INERTIA EFFECTS 

C 

1250 RESEF = BETAS ( I ) - 0.5 * DBSU) 

DELI = 0. 

I F ( DZLE .GE. 0.) GO TO 137 
I F ( DEL2 .GT. 0.001*BETAS( I )) GO TO 1354 
POWER 1 * - PI * DMB / TAUL /S I N ( BETAS ( I )) 

DELO = BESEF - BETAP ( I > 

DELI = DEL0*EXP(P0WER1)/(1.-DEL0*(1.-EXP(P0WER1) >/TBS!l> > 

C 

C END FLUID INERTIA EFFECTS 

C 

1354 I F ( NREV .EQ. 1 .OR. C8HR .EQ. 0.0 > DBTC(J.I) = 0.0 
BETA ( I ) = BESEF - DELI - DEL2 + DBTC(J*I) 

I F ( BET A ( I ) *LT. 0.0 ) BETA < I ) = 0.5/57.2957 
137 DBETA = BETA ( I ) * BETAP ( I ) 

BETAB = 0.5 * ( BET A ( I ) + BETAP! I > ) 

SBB = SIN ( BET AB ) 

CBB * COS! BETAB) 

DBDM(I) = DBETA / DM! I) 

IF (DZLE .GE. 0.) DBS! I) = BETAS! I) - BETA! I) 

W ( I ) = VM / SIN (BETA! I)) 

WVX! J.I ) = W ! I » 

IF! DZLE .GE. 0. ) WJ1 ( I ) =W ( I ) 

IF (J .EQ. NJ) WN J < I ) = W(l) 

QD = Cl * W ( I ) **2 

WB * < WP( I ) + W(I) ) / 2.0 

VMB * WB*SBB 

WUB = WB*CBB 

UB = 0MEGA*RB 

VUB = UB— WUB 

TAULB - ( T AU ( I ) - B ( I ) + TAUP(I) - BP ( I ) ) / 2.0 
QDB * Cl * WB**2 
F = 1.0 

DWDM! I) = ( W(I) - WP!I) > / DM! I) 

IF (DZLE .GE. 0.) GO TO 996 
IF ( MU .NE. 0.0 ) GO TO 1372 
XMTH(I) «= 0.0 
DELS = 0.0 
CF - 0.0 
GO TO 996 
1372 CONTINUE 
C 

C START BOUNDARY LAYER CALCULATIONS 

C 

RET = WP(I) * XMTHP(I) / NU 
XKL-XMTHP! I ) /WP( I >* DWDM! I) 

CF = 0.246/ ( 10.**(0.678*HSFP( I ) ) * RET**0.268 ) 

DTDM = CF / 2.0 - ( HSFP(I) + 2.0 ) * XKL 

CL = RET**0» 16666 * XMTHP<I> / 0.0135 / EXP ( 5. 0* ( HSFP ( I ) - 
HSF(I) = 1,4 - RET#*0. 16666 * XKL / 0.0135 
HSF ( I ) =HSF ( I ) — ( HSF ( I ) -HSFP ( I ) ) *EXP ( -DMB/CL ) 

IF! HSF(I) ,GT. 3.0 ) HSF ( I ) * 3.0 
IF! HSF(I) ,LT. 1.0 ) HSF ! I ) = 1.0 
XMTH ( I ) = DTDM * DMB +XMTHP(I) 


00003950 
00003960 
00003970 
00003980 
Q0003990 
00004000 
00004010 
00004020 
00004030 
00004040 
00004050 
00004060 
00004070 
00004080 
00004090 
00004100 
00004110 
00004120 
00004130 
00004140 
00004150 
00004160 
00004170 
00004180 
00004190 
00004200 
00004210 
00004220 
00004230 
00004240 
00004250 
00004260 
00004270 
00004280 
00004290 
00004300 
00004310 
00004320 
00004330 
00004340 
00004350 
00004360 
00004370 
00004380 
00004390 
00004400 
00004410 
00004420 
00004430 
00004440 
00004450 
1.4)) 00004460 

00004470 
00004480 
00004490 
00004500 
00004510 
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ZZ5=.05 * TAUL * SBS ( I ) 

IF ( XMTHC I ) » GT • ZZ5 ) XMTH(I) *ZZ5 

IF< XMTH < I ) .LE. 0,0 ) XMTH(I) * XMTHI(I) 

DELS * XMTH < I > * HSF( J ) 

F * 1.0 - ZZ1 *XMTH(I) / TAUL / SBS(I)*2. 

I F ( I .EQ. 1 .OR. I .EQ. NI ) F * F* ( 1 .O-XMTH ( I ) / DY(I> * 2.0) 

996 I F ( DZLE .GE. 0.0 ) DELS * 0.0 
ZBL ( I ) * DELS 

END BOUNDARY LAYER CALCULATIONS 

I F ( DBSP(I) .GT. ( 0.10 * BET ASP ( I ) ) > GO TO 997 
IF C BP ( I ) .EQ. 0.0 ) GO TO 997 
AR * Win / WP ( I ) 

2Z5* (TAUL +T AUP ( I )-BP( I ) )*(DY( I )-DYP( I ) ) / ( 2 *TAUL*DY ( I ) ) 

DPDMP * C1*(WP( I )*( 1.0 - AR ) ) **2 + (PXP(I> - PSAT)*(1. - AR-ZZ5) 
I F ( DPDMP «LT. 0.0) DPDMP *0.0 

997 CONTINUE 

PREL<D * PRELP ( I ) + C3 * I R (I ) **2 - RP(I>**2 ) - DPDMP 
PRELL ( J « I ) * PREL(I) 

WNC ( J * I ) = ABS ( WNC ( J. I ) ) 

I F I NREV .EQ. 1 .OR. CBHR .EQ. 0.0 > WNC(J»I) * 0.0 
PORELd) * PREL(I) - ( 1.0 - F ) * QD -( RHO/2 • /G*WNC ( J» I ) **2. ) 

PX ( I ) * PREL ( I ) - QD 

PXL(J.I) * PX(I) 

DC ( I)*0.0 

XA * A(I) - DYd) * COS ( SI ( I ) ) * DCII) 

XA*A( I ) 

I F ( DZLE .LT. 0. )GO TO 96 
DPBN(Jd) * 2.0* (PX(I) - PSAT) 

GO TO 952 

96 TERMl(I) = ( 2.0 * OMEGA / WB - CBB / R(I)> * SINISI(D) 

TERM2 ( I ) * DBDM( I ) 

DPBN(J.I) = 2.0 * TAULB * QDB * SBB**2/SBS( I ) 

1 * ( TERM1 < I ) + TERM2 ( I ) ) 

I F ( DBSPII) .GT. (0.10 * BETASP ( I ) ) ) GO TO 121 
GO TO 204 

CHECK MOMENTUM BALANCE (FOR EACH STREAMTUBE) 

121 DTH* T ( I ) -TP ( I ) 

DYB * ( DY( I ) + DYP (I) ) * 0.5 

AB* ( AP ( I > *S IN ( BETASP ( I ) ) + XA *SBS(I>)/2. 

PB * ( PX( I ) + PXP( I ) ) / 2.0 
I F ( J .EQ. 1 ) GO To 951 
WETP * ZZ1 * DYB 

I F ( I .EQ. 1) WETP* ZZ1*DYB + TAULB* ( RH (J-l ) + RH( J ) ) / (RPC I ) + R( 
1 I ) ) * SBSB 

I F ( I .EQ.NI) WETP* ZZ 1*DY8 + TAULB*(RT ( J-l ) + RT ( J ) ) / I RP C I ) + R( 
1 I ) ) * SBSB 

FD = CF * QDB * WETP * DMB 
951 FC = 2.0 *C1*AB*(RU)-RP( I ) )*VUB**2/RB 
ZZ1 = PSAT * DYB * DTH 
DB = DB + DC( I ) - DCP ( I ) 

ZZ2* PSAT *DYB*DB*SB5B 

ZZ3 * 2.0 * PB * ( DYB - DY ( I ) ) * SBSB * (TAULB - DC ( I ) / 2.) 


00004520 

00004530 

00004540 

00004550 

00004560 

00004570 

00004580 

00004590 

00004600 

00004610 

00004620 

00004630 

00004640 

00004650 

00004660 

00004670 

00004680 

00004690 

00004700 

00004710 

00004720 

00004730 

00004740 

00004750 

00004760 

00004770 

00004780 

00004790 

00004800 

00004810 

00004820 

00004830 

00004840 

00004850 

00004860 

00004870 

00004880 

00004890 

00004900 

00004910 

00004920 

00004930 

00004940 

00004950 

00004960 

00004970 

00004980 

00004990 

00005000 

00005010 

00005020 

00005030 

00005040 

00005050 

00005060 

00005070 
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ZZ3=ZZ3+PB*C2*(RP ( I ) *S I N ( BETASP I I ) ) -R ( I )*SBS<I ) )*DYB 
FP = (ZZ1 + ZZ2 + ZZ3) * CSB I 1 ) 

DMOM= FC - FP - FD 

952 MOM ( I ) * PXII) * XA * SBS I I ) + 2.0 * Cl *QUJ* Will * 

1 COS (BETAS! I ) - BET A (I I I * F **0.5 

I F < DZLE .GE. 0.) GO TO 204 
ERRORl® MOM ( I ) - MOMP ( I) - DMOM 
I F ( B ( I ) • GE • ( . 8*T AU C I ) ) ) GO TO 204 
CONVERENGE TEST FOR MOMENTUM BALANCE. 

IF ( ABS (ERRORl ) .LT. 0.0001*MOM (III GO TO 204 

ADJUST CAVITY SLOPE 

DDBSSV * DBS ( I ) - DBSSAV 
DBSSAV = DBS ( I ) 

IF ( ERRORl ) 142. 204 » 150 
142 DBS ( I ) = DBS ( I ) - 0.001 * BET AS t I ) 

IF I DBS ( I ) .LT. 0.0 ) DBS I I ) = 0.0 
GO TO 151 

150 DBS ( I ) = DBS ( I ) + 0.001 * BET AS C I ) 

IF (DBS I I ) .GT. BETAS (II) DBS ( I > =0.95*BETAS II ) 

151 IT8 ( I ) = ITBUI+l 

I F ( I TB ( I ) .LE. 2 ) GO TO 140 

I F ( ( DBS(I) - DBSSAV ) * DDBSSV .GT. 0.0 I 60 TO 140 

GO TO 204 

END CAVITY ITERATION 


EXIT STATION FLOW CALCULATIONS 

6 PREL(I) * PRELP(I) + C3 * < R( I 1**2 - RP< I ) * *2 ) 

PRELEX ( I ) = PREL ( I > 

ZZ1 = 0.0 

IF (I .EQ. 1 .OR. I .EQ. NI ) ZZ1 = ZBL(I) 

VM = Q ( I ) / ( DY ( I ) *CQS (SI(I ))-ZZl)/C2/R(I) 

VU = RVU ( I ) / R ( I I 
WU « U - VU 
BETA ( I ) = ATAN ( VM/WU) 

W(I) = VM / SINIBETAI I } ) 

WEXI I) = WU) 

QD = Cl * W( I ) **2 
PX ( I ) = PREL I I ) - QD 

CALCULATE RADIAL PRESSURE GRADIENT 
FOR ALL STREAM TUBES 

204 I F ( I .EQ. 1 ) GO TO 131 
C G0T0131 

DPR = PXI'I ) - PXII-1 ) 

DSR * R(I) - RII-1) 

ZZ5MRII) *OMEGA - W(I) * COSIBETAII))) ** 2 /Rill 
ZZ6=<RU-1> * OMEGA - W(I-l) * COS ( BETA ( 1-1 )) ) **2 /R(I-l) 
DPDSR= RHO * IZZ5 + ZZ6 ) / G/2.0 

IF ( J .GT. NJ .OR. DZLE .GE.O.VGOTO 1311 
ZZ1 * SISU-1) 

ZZ5= ( S IS ( I-l ) -SISPU-1)) / DZ 


00005080 

00005090 

00005100 

00005110 

00005120 

00005130 

00005140 

00005150 

00005160 

00005170 

00005180 

00005190 

00005200 

00005210 

00005220 

00005230 

00005240 

00005250 

00005260 

00005270 

00005280 

00005290 

00005300 

00005310 

00005320 

00005330 

00005340 

00005350 

00005360 

00005370 

00005380 

00005390 

00005400 

00005410 

00005420 

00005430 

00005440 

00005450 

00005460 

00005470 

00005480 

00005490 

00005500 

00005510 

00005520 

00005530 

00005540 

00005550 

00005560 

00005570 

00005580 

00005590 

00005600 

00005610 

00005620 

00005630 

00005640 
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ZZ6 » ( W< I ) *SI N ( BETA ( I ) ) + v* < 1-1 )*SIN (BETA! 1-1) ) ) *0.5 
DPDSR = DPDSR - 2 •0*Cl*ZZ6*ZZ6*Z25*C0S < ZZ1 ) **2 
ZZ4 = ( WP( I ) *S IN < BETAP ( I ) ) + WP ( 1-1 ) *S I N t BE TAP ( 1-1 ) ) ) *0 .5 
ZZ2 = ( ZZ6 - ZZ4)/DZ 

DPDSR * DPDSR - C1*ZZ2*S IN( 2.0*ZZ1 ) *ZZ6 
1311 ESV ( I ) = EU) 

E C I > = ( DPR/DSR - DPDSR) 

SME2 * SME2 + ABS(E( I > ) 

131 CONTINUE 

G0T0144 

CHECK RADIAL EQUILIBRIUM 

I F ( SME2 .LT. ( ETOL * PX(NI)) / DR ) GO TO 144 
IF ( ITE .LT. 53 ) GO TO 133 
DO 132 I = 2 » N I 

I F C ESVII) * E(I) .LT, 0.0 ) GO TO 132 
ERROR=.TRUE. 

132 CONTINUE 

I F ( .NOT. ERROR ) GO TO 144 

133 CONTINUE 

I F ( ITE .EQ. 200) GO TO 130 

ADJUST STREAMLINES 

DO 141 I = l.NXXI 
NXI =1+1 
ZZ4 = PCRDL 
ZZ5 = E ( NXI ) 

IF ( ITE .EQ. 1 ) GO TO 139 
ZZ6 = ESV/ ( NXI ) 

ZZ1 = PCR( I ) - PCRl < I ) 

ZZ2 * ABS ( ZZ6 ) - ABS1ZZ5) 

IF ( ( ZZ 1#ZZ2 ) .LT. 0.0) ZZ4 = -PCRDL 
139 PCRl (I ) « PCR ( I ) 

141 PCR ( I ) * PCR ( I ) + ZZ4 / SME2 * ABS { ZZ5 ) 

130 CONTINUE 

END STREAMLINE ITERATION 

44 IF ( J ,GT. NJ ) GO TO 404 
VOL * 0. 

CALCULATE J-STATION STREAM TUBE parameters 

call PRNT5( J,Z( J) »ITE) 

JSTOP = 0 
DO 299 I«1.NI 

VOL = VOL + (B(I) * SIN (BET ASM)) + BP (I) * SIN (BETASP ( I ) ) ) 
1 * DM( I ) * (DY( I ) + DYP(I) ) / 4. 

U = OMEGA * R ( I ) 

VM = W( I ) * SI N ( BETA ( I ) ) 

WU * Will * COS ( BETA ( I ) ) 

VU = U - WU 

RVU ( I) = R(I) * VU 

ALPHA=ATAN2 ( VM »VU ) 


00005650 

00005660 

00005670 

00005680 

00005690 

00005700 

00005710 

00005720 

00005730 

00005740 

00005750 

00005760 

00005770 

00005780 

00005790 

00005800 

00005810 

00005820 

00005830 

00005840 

00005850 

00005860 

00005870 

00005880 

00005890 

00005900 

00005910 

00005920 

00005930 

00005940 

00005950 

00005960 

00005970 

00005980 

00005990 

00006000 

00006010 

00006020 

00006030 

00006040 

00006050 

00006060 

00006070 

00006080 

00006090 

00006100 

00006110 

00006120 

00006130 

00006140 

00006150 

00006160 

00006170 

00006180 

00006190 

00006200 
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9085 

299 

9086 
30 0 


404 

405 


V = VM / S I N < ALPHA ) 

PT = POREL ! I ) + Cl * (V**2 - W ( I ) **2 ) 

H = PT / RHO - HO ( I ) 

H I I = U * VU / G - HI 0 ( I ) 

ETA = H / H I I 

IF CM ( I ) .LE. 0. >ETA=1.0 

PCB b BID / TAUI I ) 

DEV = ( BETAS! I ) - BETA! I > > 

BN = BI D * SIN! BETAS! I ) ) 

MSTR= M(I) + BII) * COS I BETAS ( I ) ) 

IF IPX! I) «GE« 0.0) GO TO 9085 
JSTOP = 1 
PXS = PX ( I ) 

CONTINUE 

CALL PRNT67 ( J »Z ( J ) ♦ I *RSTS < I ) .PCR! I) »R( I ) * TAU < I ) * T (I) *B (I) *PX l I ) » 

1 PREL! I) » POREL ! I ) »PT »MSTR .BN.PCB.BETA! I) * BET AS! I ) »DEV 

2 DBS! I ) * XMTH ( I ) »ZBL ( I ) .HSF ( I ) .ALPHA. ETA .W ( I ) .U.V.VU. 

3 VM.ITE) 

IF ( J .NE. NJ) GO TO 299 

POREL ! I ) = POREL ( I ) - QD * t T ! I ) / C2 / R ! I ) / S I N ! BET AS ( I ) ) ) **2 
PREL (I) = POREL! I ) 

IF ( I .EQ. 1 .OR. I .EQ. NI) PREL < I ) »POREL ( I ) + 2.0*XMTH(I)/ 

1 DY ! I ) *QD 
CONTINUE 

CVOL = CVOL + VOL * NB 

IF! JSTOP .EQ. 0 ) GO TO 300 

WRITE! 6*9086 ) PXS 

FORMAT!/////' NEGATIVE PRESSURE OF '♦F16.5. 

1 » EXECUTION SUPPRESSED* ) 

GO TO 4501 
CONTINUE 
J = NJ + 1 
2 « J ) = Z ! NJ ) + DZ 
RT!J) = RTtNJ) 

RH < J ) * RH(NJ) 

BTS ! J ) = BTS l N J ) 

BH5IJ) = BHS(NJ) 

GO TO 1252 

EXIT ROUTINE 
< DOWNSTREAM ) 

CONTINUE 
WRITE <6.405) 

FORMAT ( lHl # T54 . 


IV’ 


T6 1 » 


•H' . 
T47. 


T75 » 

• V» , 


•EXIT CONDITIONS 1 // T19. 'I' 
T88 . * PT ' ♦ T102 » »ETA« 


•P» . 

T60. 


♦ T33 . 
/T 1 7 » 


' R • . T46. * 


2 'BETA'. 

SMH * 0. 

SMH I = 0. 

DO 450 I = 1 * N I 
U = OMEGA * R! I ) 

VU = RVU ( I ) / R! I ) 

WU = U - VU 

VM * W( I) * SI N ( BETA ( I ) ) 
VEX { I ) = VM 
ALPHA= ATAN2 ( VM »VU ) 

V * VM / SIN! ALPHA ) 


' VM ' . T74, 'VU' » T8 8 . 'WU' » 


'ALPHA' . 
T103 » 'W' 


T3 


00006210 
00006220 
00006230 
00006240 
00006250 
00006260 
00006270 
00006280 
00006290 
00006300 
00006310 
00006320 
00006330 
00006340 
00006350 
. 00006360 
00006370 
00006380 
00006390 
00006400 
00006410 
00006420 
00006430 
00006440 
00006450 
00006460 
00006470 
00006480 
00006490 
00006500 
00006510 
00006520 
00006530 
00006540 
00006550 
00006560 
00006570 
00006580 
00006590 
00006600 
00006610 
00006620 
00006630 
00006640 
DE00006650 
1*00006660 
00006670 
00006680 
00006690 
00006700 
00006710 
00006720 
00006730 
00006740 
00006750 
00006760 
00006770 
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N I ) POREL ( I ) i 
V**2 - W( I ) **2 


PREL { I)-2.*XMTHC I)/DY 
) 


57,2958 


BETAE = AT AN ( VM/ WU ) 

QD = Cl * WP( I )**2 
PORELU ) = PREL ( I ) 

IF (I * EO, 1 .OR. I .EG. ND POREL (I) *PREL { I) 
PT = POREL ( I) + Cl * < V**2 - W(I)**2 ) 

H = PT / RHO - H0( I) 

HI I = U * VU / G - H 1 0 ( I ) 

ETA = H / H I I 

SMH a SMH + H * Q ( I ) 

SMHI = SMH I + HI I # QII) 

DEV » (BETAS! I) - BETAE ) * 57,2958 
ALPHA = ALPHA * 57.2958 
BETAE * BETAE * 57,2958 

WRITE (6*411 ) I* R ( I ) * DEV* H, PX ( I J ♦ PT* ETA, 
1 VM, VU* WU* W<I) 

411 FORMAT ( 1HO » T 1 2 * 10X * I 4 »6E14 .6 / T12 * 7E14.6 
450 CONTINUE 


OVERALL PERFORMANCE 

H = SMH / QI * FLOAT (NB) 

H I I = SMHI / QI * FLOAT ( NB ) 

ETA « SMH / SMHI 

SIOP a G * H / ( OMEGA * RT ( 1 ) ) **2 

RN a OMEGA * RT ( 1 ) #*2 / NU 

SS = OMEGA * QI**»5 / (G * NPSH)**.75 

SIID a SIOP/ETA 

SIL = SIID - SIOP 

I F ( CBHR .EG* 0.0 .OR. NREV .EG. 1 ) GO TO 250 
DELTR * ( RT ( 1 ) - RH(1> + RT(NJ) - RH(NJ) ) / 2* 

ARR a DELTR / (2(NJ) - 2(1)) * SIN(BTSB) 

SIL = (SILSAV/SIID +(0.7 * CBHR/ SIN(BTSB) * SIID) 


ALPHA* BETAE* 


ARR )**0i 


1 PH/SI ID * CBHR / SIN(BTSB) * ARR)**0.! 
SIOP = SIID - SIL 
ETA = SIOP / SIID 
H a SIOP / G * ( OMEGA*RT ( 1 ) )**2 
HI I a SIID / G * (OMEGA*RT { 1 ) ) **2 
SILSAV = SIL 

CALL PRNT8 (NPSH* PH* SIOP* H» HII* RN 
WR I TE (6*27) SI ID»SI L 

FORMAT ( /// • PSI IDEAL = • *F 10 . 5 *5X * • PS I 


SIID 


( OMEGA*RT ( 1 ) )**2 
* (OMEGA*RT{ 1 ) )**2 


ETA* 


Gl * CVOL ) 


LOSS » F 1 0 , 5 ) 


I F ( LOADOP ,EQ. 0) GO TO 4501 

CALL LOAD(PXL*ML*DpBN*NJ*NI »TCBS I ,TCBS»PSAT »BL»PRELL»C1 *WlN* 
INB *R IN »BSI N ♦ PREL I »VA » WNU »REX » BSEX » VEX *2 »RL * WEX »PRELEX» VT» 
1 RHO »G » PC2 ♦ TP ♦ T ♦ BETAS »D2 ,C2 »WPX , WSX » PPX *PSX ) 

I F ( CBHR .EG. 0.0 .OR. NREV .EG. 2 ) GO TO 4501 

VORTEX CALCULATIONS 

DO 906 J=2 * N J 
CGAMP = C6AM 
GAMP = GAM 
AVP = AV 


00006780 
00006790 
00006800 
( I ) *0000006810 
00006820 
00006830 
00006840 
00006850 
00006860 
00006870 
00006880 
00006890 
00006900 
V, 00006910 
00006920 
00006930 
00006940 
00006950 
00006960 
00006970 
00006980 
00006990 
00007000 
00007010 
00007020 
00007030 
00007040 
00007050 
00007060 
00007070 
00007080 
00007090 
00007100 
0* ( 00007110 

00007120 
00007130 
00007140 
00007150 
00007160 
00007170 
00007180 
00007190 
00007200 
00007210 
00007220 
WJ1* 00007230 
PTU *00007240 
00007250 
00007260 
00007270 
00007280 
00007290 
00007300 
00007310 
00007320 
00007330 
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VIP = VI 
XLAMP = XLAM 
I = NI 

IF ( KILL .ECU 1) GO TO 9081 
IF ( PSXUfI) *LE. PPXt J*I) ) GO TO 9078 
9081 AV » AVP 
KILL = 1 
GO TO 9079 

9078 XLAM = ARCOS ( WPXU.I) / WSX(J»I> ) 

XLAMX = XLAM * 57.2958 
XLAMB * (XLAM + XLAMP > /2. 

GAM * 2. * WSXU.n * SIN (XLAM / 2.) 

GAMB * (GAM + GAMP) / 2. 

VI = WSXIJtl) * COS (XLAM / 2.) 

VlB = (VI + VIP)/ 2. 

VORTEX RADIUS ITERATION 

KK = 0. 

AVC = GAMB * DMVX(J.I) / (4. * PI * VlB) 

AVC1 = AVC 
925 KK = KK + 1 

IF (KK .GT. 300) STOP 

DADM * GAMB 7(4. *PI * VlB) * ALOG ( 1 + CLEAR / AVC) 

IF ( XLAM .EQ. 0. ) DADM = 0. 

AV = AVP + DADM * DMVX(J.I) 

IF { ABS ( ( AV - AVC ) / AV ) .LE. .001 ) GO TO 98 
AVC = (AV + AVC) / 2. 

GO TO 925 

98 CGAM* ( CGAMP+GAMB*TAN ( XLAMB/2. ) #DMVX ( J » I ) * FLR ) / < 1.+ GAMB * 
1 DMVX ( J» I )*FLR / ( 4 , * PI * ( AV + CLEAR) * VlB) ) 

9079 OTCV = CGAM /( 2. * PI * AV **2 ) 

UPLIM = RT(J) 

LOWLIM = RT(J) - 2. * AV 
C 

DO 906 I =1 »N I 

RW = RT(J) + CLEAR 

R 1 = RL ( J * I ) - DYX ( J ♦ I ) /2. 

R2 a RL ( J. I ) + DYX ( J * I ) /2 • 

IF C I .EO. NI ) R2 = R2 + CLEAR 

RC = RT(J) - AV 

Y1 = RW - R2 

Y4 a RW - R 1 

Y2 a RW - (RC + AV) 

Y2 a AMAXKY2.Y1) 

Y2 = AMINKY2.Y4) 

Y3 = RW - (RC - AV) 

Y3 = AMAXKY3.Y1) 

Y3 a AM INI (Y3»Y4) 

S a TAUVX(J.NI) * S IN ( BETASX ( J »NI ) ) 

BTIP a S / 2. 

LI a TAUVX(Jtl) * SIN(BETASX< J»I ) ) 

BI * (LI / S) * 8TIP 

XI = BI - AV 

X2 = BI + AV 

AFAS = Li * ( Y4 - Yl) 

TGIS = AV* ( Y3**2 - Y2**2) -2*AV *(RW -RC)* <Y3 -Y2» 


00007340 

00007350 

00007360 

00007370 

00007380 

00007390 

00007400 

00007410 

00007420 

00007430 

00007440 

00007450 

00007460 

00007470 

00007480 

00007490 

00007500 

00007510 

00007520 

00007530 

00007540 

00007550 

00007560 

00007570 

00007580 

00007590 

00007600 

00007610 

00007620 

00007630 

00007640 

00007650 

00007660 

00007670 

00007680 

00007690 

00007700 

00007710 

00007720 

00007730 

00007740 

00007750 

00007760 

00007770 

00007780 

00007790 

00007800 

00007810 

00007820 

00007830 

00007840 

00007850 

00007860 

00007870 

00007880 

00007890 

00007900 
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TPS= 2 • * PI / S 

00007910 


APC ■ AV + CLEAR 

00007920 


Ml = TPS * ( Yl-APC ) 

00007930 


M2 = TPS * (Y2-APC) 

00007940 


M3 = TPS * (Y3-APC) 

00007950 


M4 * TPS * (Y4-APC) 

00007960 


N1 a TPS * ( Yl+APC ) 

00007970 


N2 = TPS * ( Y2+APC ) 

00007980 


N3 = TPS * ( Y3+APC ) 

00007990 


N4 = TPS * (Y4+APC5 

00008000 


DO 57 N- 1 » 4 

00008010 


GO TO(51*52»54»54) ,N 

00008020 

51 

UP = Li 

00008030 


LOW * X2 

00008040 


GO TO 58 

00008050 

52 

UP = XI 

00008060 


LOW » 0. 

00008070 


GO TO 58 

00008080 

54 

UP * X2 

00008090 


LOW = XI 

00008100 

58 

DX = (UP - LOW) /25. 

00008110 


XX = LOW -DX 

00008120 


DO 59 KX=1 ♦ 26 

00008130 


XX = XX + DX 

00008140 


XL = 2. * PI / S * (XX - 01 ) 

00008150 


GO TO (61*61 »63*64) »N 

00008160 

61 

FUNC(KX) a ALOG ( ( (COSH < M4 )-COS ( XL > )/ (COSH (Ml ) -COS (XL) > ) /(( 

00008170 


1 COSH { N4 ) -COS ( XL )) / ( COSH ( N1 ) -COS ( XL > ) )) 

00008180 


GO TO 59 

00008190 


GO TO 59 

00008190 

63 

FUNC ( KX ) = ALOG ( < ( COSH < M2 >-COS ( XL ) ) / ( COSH (Ml )-COS ( XL ) ) ) /(( 

00008200 


1 COSH ( N2 ) —COS (XL))/ ( COSH ( N1 ) —COS ( XL ) ) )) 

00008210 


GO TO 59 

00008220 

64 

FUNC ( KX ) = ALOG ( ( < COSH ( M4 ) -COS < XL ) ) / (COSH < M3 ) -COS ( XL ) ) ) /(( 

00008230 


1 C0SH(N4)— COSH(XL) )/( COSH ( N3 ) — COS ( XL ) ) >) 

00008240 

59 

CONTINUE 

00008250 


CALL QSF (DX»FUNC*YOUT *26) 

00008260 

57 

TGIF(M) = S / ( 2 • *P I ) * YOUT { 26 ) 

00008270 


TGSUM = TGIF(l) + TGIF12) + TGI F ( 3 ) + TGIF(4) 

00008280 


WNC ( J » I ) =1./ AFAS *(FLR * CGAM /<2.*S ) * TGSUM + OTCV * TGIS) 

00008290 


DBTC ( J » I ) * ATAN( WNC (J*I» / WVX ( J » I ) ) 

00008300 


R 1 = Rl*12. 

00008310 


R2 = R2412. 

00008320 


RC = RC*12« 

00008330 


RW = RW*12. 

00008340 


AVX a AV * 12. 

00008350 


XI = X 1*1 2 • 

00008360 


X2 = X2*12. 

00008370 


Y1 = Yl*12. 

00008380 


Y2 = Y2*12. 

00008390 


Y3 = Y3*12. 

00008400 


Y4 = Y4*12. 

00008410 


TGIS = TGI S*12 • 

00008420 


TGSUM= TGSUM*12. 

00008430 


S a S * 12. 

00008440 


LI = LI * 12. 

00008450 
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BT IP = BTIP * 12. 

BI = BI * 12. 

APC * APC * 12. 

TPS = TPS * 12. 

AFAS = AFAS * 12. 

Ml = Ml *12. 

M2 = M2*12. 

M3 = M3*12 . 

M4 = M4*12. 
ni = Ni*i2. 

N2 = N2*12. 

N3 = N3*12. 

N4 = NA*12 . 

TX = FLR * CGAM /<2.*S ) 

DO 68 KKK=1 » A 

68 TGIF(KKK) * TGIFCKKK) *12. 
906 CONTINUE 

IF ( NREV #EQ. 1) GO TO 926 


00008460 

00008470 

00008480 

00008490 

00008500 

00008510 

00008520 

00008530 

00008540 

00008550 

00008560 

00008570 

00008580 

00008590 

00008600 

00008610 

00008620 

00008630 


II IF ! CASE .EQ. CASES ) GO TO 1 
CASE = CASF +1 
GO TO 20 

2 FORMAT ( 20A4 ) 

. FORMAT <4F 10.0) 

4 FORMAT 1 1H1 . 6 IX » ‘DECK 6091 * 
1 PROGRAM* /// 3Xt 20A4 // ) 

3 FORMAT ( 415 . F15.5 .3F10.4) 


FORMAT 1 4X 


*7X» 


16 X ♦ *G* *10X» • CBHR * / /3X » I 3 »8X * 1 3 »2 { 7X » 
FORMAT! ////6X» * Z* .14X » * RH * * 1 3 X * * R T * .1 
1 * TT ' * 13X » * TA ' // ) 

8 FORMAT (IX* 13. F9.5. 6F15.5 ) 

2 3 FORMAT ( // T45* 'PO»* T60» *VM*» T75 ♦ 
FORMAT (4F10.4. 110 J 
FORMAT (7F10. 4) 


00008640 

00008650 

00008660 

00008670 

00008680 

IX .'INDUCER HYDRODYNAMIC P00008690 

00008700 
00008710 
*NB * * 9X » * CASES * .0000 8720 
14) »4X .F10.5.F12.4 ) 00008730 

3X . * BH* * .12X. 'BT*' .12X. 00008740 


•ALPHA' / < T36. 3F15.5)) 


22 FORMAT! 1H1 . 10X . ' CASE NUMBER -* .I4//31X. *RHO' . 13X. «MU* . 00008800 

1 11X. • PSAT * » 1 2 X » » SN ' . 12X » ' LOADOP ’ //23X.4F15. 5.110//) 00008810 

785 FORMAT! 1H1 . 10X. * CASE NUMBER - * » 1 4/ /3 1 X. ' RHO * * 1 3X . ' MU ' » 1 IX * 00008820 

1 'PSAT* »12X « ' SN ' ,12X. ' LOADOP • , 12X . * FLR ' //23X .4F15 .5 . 1 10 .F20 . 6// ) 0000 8830 
19 FORMAT < 3F10.0) 0000 8840 

7090 FORMAT! ////T21. 'PHI ' ,T36 » • NPSH • ,T5 1 . ' THOMA • ♦ T66 . ' VT • .T8 1 . * PT * . 0000 8850 

1 T96.'KTIP'//11X.6F15.4> 00008860 

30 F0RMAT!//T54* • INLET CONDITIONS' // T12. * I * * T29> *R'. T46. 'Q*. 00008870 

1 T63* ' W* . T80 » * PO ' . T95 * 'PREL'» T114. 'P' / T10. 'ALPHA'. T27. 00008880 


2 'BETA'. T46. 'K'» T63. 'U'» T81. 'V'. T96. *VM' . T113. 'VU'I 00008890 

41 FORMAT ! / Til. 12. T13. 6(5X. F12.5) / T6. F12.5. 6!5X .F12.5) ) 00008900 

999 CONTINUE 00008910 

cmh 00008920 
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SUBROUTINE LOAD ( PX ♦ M » DPBN ♦ NJ * NI » TCBSI ♦ TCBS » PSAT ♦ 

1 R » PREL ♦ Cll* WIN ♦ WJ1 » NB ♦ RIN » BSIN * PRELI ♦ VA * 

2 WNJ » REX » BSEX » VEX » Z * R » WEX. PRELEX. VT . PTU *RHO »G» PCZ » 

3 TP.T. BE TAS.DZ.C22.WP.WS.PP.PS) 

REAL M 

DIMENSION 

1 M ( 30 * 15 ) * PX( 30 * 15 ) * DPBN < 30 * 15 > » 

2 Alt 30 ♦ 15 > ♦ Bl( 30 » 15 ) * Cl( 30 ♦ 15 ) * 

3 Dll 30 * 15 ) ♦ A21 30 * 15 ) ♦ B2( 30 • 15 ) ♦ 

4 C2( 30 * 15 ) » D2! 30 * 15 ) * TCBSI 30 » 15 > ♦ 

5 B ( 30 * 15 ) .PRELI 30 . 15 ) » TCBSI! 15 ) . 

6 DPB ( 15 ) . PS! 30.15 ) » PXC! 15 ) * 

7 WS ( 30 ♦ 1 5 ) ♦ W ! 15 ) . WIN! 15 ) » 

8 WJ1I 15 ) * PRELI I 15 ) » BETA! 15 ) . 

9 VA! 15 ) » RIN! 15 ) ♦ BSIN! 15 ) » 

A PP< 30.15 ) . WEX! 15 ) » WNJ! 15 ) » 

B VEX! 15 ) ♦ BSEX! 15 ) ♦ REX! 15 ) . 

C WP! 30.15). ZOO) ♦ R I 30 ♦ 15 ) 

D .PRELEX (15) »PS I S ( 15 ) » PS I P ( 15 > . TP ( 15 ) » T ( 1 5 ) * XS I! 15 ) .BETAS ( 15 ) 

DATA IFV . ZRO .PI / 5 ♦ 0.0 » 3.141592 / 

DO 2 I = 1 » N I 

CALL BMFIT! IFV . NJ . M(1»I> . PX(l.I) . ZRO ♦ ZRO » 

1 Al(l. I) * Bill. I) . Cl ( 1.1) . Dl(l.I) ) 

CALL BMFIT! IFV » NJ * M ( 1 . I ) .DPBN ! 1 . I ) . ZRO » ZRO . 

1 A2 ( 1 . 1 ) » B211.I) ♦ C2 ( 1 » I ) . 02(1.1 ) ) 

2 CONTINUE 
J = 1 
9 1=1 

CALCULATE SUCTION SURFACE CONDITIONS 

10 SMN = M ( J. I ) - TCBS ( J *1) / 2.0 
XSI ( 1 ) =0. 

DT =ATAN( (TP! I >-T( I ) ) /2. * SIN! BETAS! I ) ) /DZ ) 

IF ( DT .GT. 0.0) XSI ( I > = IC22 * R(J.I>/2. -T ! I ) /S IN ( BET AS! I ) ) ) * 
1 SIN < BETAS! I ) )*TAN < DT ) 

IF (DT .GT. 0.0) SMN = SMN + XSIII) 

IF! SMN .LT. 0.0 ) GO TO 30 

PS(J.I) = PSAT 

IF! J ,EQ. 1 ) GO TO 31 

IF! B ( J » I ) .GT. 0.0 ) GO TO 31 

CALL BMEVAL ( NJ ♦ Mil. I) ♦ PX(l.I) . SMN . MERR . Al(l.I) . 

1 Bl(l. I) • Cl (1*1) . Dl(l. I) » PXC(I) . DUM ) 

CALL BMEVAL ( NJ . M ( 1 » I ) »DPBN !l . I ) . SMN » MERR » A 2 ( 1 . I > » 

1 B2I1.I) ♦ C2(1.I) . D2(l,l) . DPB(I) , DUM ) 

PS(J*I> = PXC(I) - DPB ( I ) / 2.0 
IF! PS(J.I) .LT. PSAT ) PS(J.I) = PSAT 
GO TO 31 

UNCOVERED LEADING EDGE REGION 

30 Wd) a WIN ( I ) - ( WINII) - WJld ) ) * EXP! SMN * NB / RIN! I ) / 

1 SIN I BSIN! I ) ) ) 

PS(J.I) = PSAT 

IF (J .EQ. 1) GO TO 31 
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IF ( BIJ»I) .GT. 0.0 ) GO TO 31 
PXC(I) = PRELI (I) - Cll* W< I )**2 
BETA (I ) = ARS I N ( VAII) / W ( I ) ) 

DPB(I) = 2.0 * PI * Cll* VAII) / COS (BETA (I) ) * S I N < BETA ( I ) ) **2 

1 / S I N ( BSI N ( I ) )**2 * ( WIN ( I) - W J 1(1) ) * EXP( SMN * NB / 

2 R I N ( I ) / S I N ( B S I N ( I ) ) ) 

PS(J.I) = PXC ( I > - DPBCI) / 2.0 
I F ( PS(J.I) .LT. PSAT ) PS( J»I ) = PSAT 

31 WS( J.I )=SQRTC (PRELI ( I ) - PS < J » I ) ) /Cll 

CALCULATE PRESS. SURFACE CONDITIONS 

40 SMN = M ( J » I ) + TCBS(J.I) /2.0 + XS I ( I > 

PP(J.I) = PREL ( J * I ) 

IF ( J .EG. 1 ) GO TO 59 

I F ( SMN .GT. M ( N J » I ) ) GO TO 50 

CALL RMEVAL ( NJ » M ( 1 » I ) » PX ( 1 » I ) * SMN * MERR * A1(1»I) » 

1 Bid. I) . Clll.l) ♦ DKl. I) ♦ PXC(I) . DUM ) 

CALL BMEVAL ( NJ » M( 1 » I ) »DPBN ( 1 » I ) t SMN » MERR » A2(1.I) » 

1 82(1*1) * C2U.I) * D2 ( 1.1) » DP9 ( I ) > DUM ) 

PP(J.I) = PXC(I) + DPB(I) / 2.0 

I F ( PP(J.I) .GT. PRELI J.I ) ) PP(J.I) * PREL (J.I ) 

59 WP ( J ♦ I ) = SQRT ( ( PREL ( J.I) -PP(J.I)) / Cll) 

GO TO 60 

UNCOVERED TRAILING EDGE REGION 
50 SMNE * SMN - M ( N J ♦ I ) 

W ( I ) = WEX(I) - ( WEX(I) “ WNJ(I) > * EXP ( -SMNE * NB / REX(I) / 

1 S I N ( BSEX ( I ) ) ) 

PXC(I) = PRELEX ( I ) - Cll* W ( I )**2 

BETA (I) *ARS I N ( VEX ( I ) / Mil) ) 

DPB(I) = 2.0 * PI * Cll* VEX(I) / COS ( BETA! I) ) * S IN ( BETA ( I ) ) **2 

1 / SIN (BSEX I I ) )**2 *( WEXM) - WNJ(I)) * EXPI-SMNE * NB / 

2 REX ( I ) / SI N I BSEX l I ) ) ) 

PP(J.I) » PXC ( I > + DPB(I) /2.0 

I F ( PP(J.I) .GT, PRELEX ( I ) ) PP(J.I) * PRELEX I I ) 

WP( J.I )=SQRT( ( PRELEX ( I ) - PP(J.I ))/ Cll) 

60 DPB(I) = PP(J.I) - PS(J.I) 

PSIS(I)= G* (PS( J.I )-PTU) /RHO/VT **2 
PSIP(I)= G* (PP( J.I )-PTU) /RHO/VT **2 
1=1 + 1 

I F ( I .LE. N I ) GO TO 10 
PCZ = Z(J) / Z ( N J ) 

C 

I F C J .EG. 1) WRITE (6.11) 

11 FORMAT (1H1.T45.* BLADE LOADING DATA* ) 

WRITE(6.1) J.Z( J) .PCZ 

l format (//////iox. , j'.14x.*z*.iax.*z/zt*//iii»2F19.5> 

WRITE (6. 7) ( I »R ( J» I ) »PS( J. I ) »PP (J.I) *WS( J. I ) »WP (J.I) .DPB 1 1 ) . PS I S < I I 
1 ♦ PSIP< I ) . 1 = 1 »NI ) 

7 FORMAT ( /// 9 X ♦ ' I * . 1 A X ♦ * R ' »13X »*PS'.13X.*PP*.13X»'WS*.13X.'WP’.13X. 
1*DPB*.12X.*PSIS* . 12X, *PSIP* // ( U1.8E15.5/ ) ) 

J = J + 1 

I F ( J .LE. NJ) GO TO 9 

RETURN 

END 
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C PRINT SUBROUTINE FOR DECK 6091 

SUBROUTINE PRNT5CJ »Z *ITE > 

WR I TE ( 6 » 22 ) J * Z ♦ ITE 

22 FORMAT ( 1H1 * * STATION J *»»I3» • » Z = • F10.5 , • , ITE * • * I -4 ) 

WRITE (6*1) 

1 FORMAT ( // T8 » ' I * ,123, • RST ' ♦ T3 8 * ' PCR * » T53 » ' R ' ♦ T68 ♦ * TAU » » T83 ♦ 

1 *THK' »T98, *B' /T8 ,'P* ,T23»'PREL» ,T38, 'POREL* ,T 53 ♦ ' PT • ,T68 » *M*-' , 

2 T83, 'BN* »T98» »PCB» /T8» 'BETA' »T23 . ' BETA* • * T38, ' DEV' ,T53» 'DLB*' » 

3 T68 ♦ ' XMTH' »T83 ♦ 'DEL* ' »T98 * ' HSF • /T8 » 'ALPHA' *T 23 » • ET A • » T38 * ' W • » 

4 T5 3 » ' U • »T68 ♦ * V ' tT83 » * VU ' » T98 ♦ ' VM * ) 

RETURN 

ENTRY PRNT6? ( J *Z ♦ I *RSTS ♦ PCR »R » TAU » T * B * P »PREL » POREL *PT »MSTR »BN » 

1 PCB »BETA. BETAS »DEV»DBS» XMTH, ZBL* HSF .ALPHA. ETA *W»U*V 

2 VU.VM.ITE) 

25 BETADG = BETA * 57,2958 
ALPH = ALPHA * 57.2958 
DE * DEV * 57.2958 
BETS =BETAS * 57.2958 
DB1 = DBS * 57,2951 

WRITE (6.2 ) I iRSTS.PCR.R.TAU.T ♦ B ,P » PREL .POREL .PT .MSTR .BN .PCB , 
1BETADG.BETS .DE . DB 1 » XMTH .ZBL .HSF .ALPH . ETA ,W .U » V ♦ VU .VM 

2 FORMAT ( /6X.I3.6X.E15.5. 

1 5E15.5 / 7E15.5 / 7E15.5 / 7E15.5) 

RETURN 

ENTRY PRNT8 (NPSH. PHI. PSI » H. HI. RN. ETA. SS . 01 • CVOL > 

WRITE (6*3) NPSH. PHI, PSI. H. HI, RN.* ETA. SS ♦ QI 

3 FORMATl/// 45 X , ' OVERALL PERFORMANCE ' //T6 ♦' NPSH '» T2 1 ♦' PHI ' ,T35 , 

1 'PSI'. T50 ♦ 'H*. T 6 5 » 'HI', T79. 'RN'. T95, 'ETA'. T110. 'SS', 

2 T 1 2 3 « »0I» // T3.F10.4, 2I2X,F12.5), 2<2X» F13.3), 2X, F14.2, 

3 3 ( 2 X , F12.5) ) 

WR I TE ( 6 , 30 ) CVOL 

30 FORMAT ( // T6.» CVOL' // E15.4) 

RETURN 

END 
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SUBROUTINE QSF H*Y,Z»NDIM 

DIMENSION Y 1 »Z 1 

HT » 3333333*H 

LI 1 

L2 2 

L3 3 

L4 4 

L5 5 

L6 6 

IF NDIM-5 7*8*1 

NDIM IS GREATER THAN 5. PREPARATIONS OF INTEGRATION LOOP 

1 SUM1 Y L2 &Y L2 
SUMl SUMl&SUMl 

SUM1 HT * Y LI &SUM1&Y L3 
AUX 1 Y L4 &Y L4 
AUX1 AUX1&AUX1 

AUX 1 SUM1&HT* Y L3 &AUX1&Y L5 

AUX2 HT* Y LI &3»875* Y L2 &Y L5 &2*625* Y L3 &Y L4 &Y L6 
SUM2 Y L5 & Y L5 
SUM 2 SUM2&SUM2 

SUM2 AUX2-HT* Y L4 &SUM2&Y L6 
Z LI 0. 

AUX Y L3 &Y L3 
AUX AUX&AUX 

2 L2 SUM2-HT* Y L2 &AUX&Y LA 
Z L3 SUMl 
Z LA SUM2 
IF ND1M-6 5 * 5 » 2 
INTEGRATION LOOP 

2 DO A I 7 »ND I M » 2 
SUMl AUX 1 

SUM2 AUX2 

AUX 1 Y 1-1 &Y 1-1 

AUX 1 AUXl&AUXl 

AUX 1 SUM1&HT* Y 1-2 &AUX1&Y I 
Z 1-2 SUMl 
IF I -NDIM 3*6*6 

3 AUX 2 Y I 6 Y I 
AUX2 AUX2&AUX2 

AUX2 SUM2&HT* Y 1-1 &AUX2&Y I&l 
A Z 1-1 SUM2 

5 Z NDIM-1 AUX1 
Z NDIM AUX2 
RETURN 

6 Z NDIM-1 SUM2 
Z NDIM AUXl 
RETURN 

END OF INTEGRATION LOOP 

7 IF NDIM-3 12*11*8 

NDIM IS EQUAL TO 4 OR 5 r r v . a 

8 SUM2 1 • 1 25*HT* Y LI &Y L2 &Y L2 &Y L2 &Y L3 &Y L3 &Y L3 6Y LA 

SUMl Y L2 &Y L2 

SUMl SUMl&SUMl 

SUMl HT* Y LI &SUM1&Y L3 

Z LI 0. 
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c 


9 


10 


11 


12 


AUX1 Y L3 &Y L3 
AUX1 AUXl&AUXl 
2 L2 SUM2-HT* Y L2 
IF NDIM-5 10 »9 *9 


&AUX1&Y L4 


AUXl Y L4 &Y L4 
AUX 1 AUX1&AUX1 

Z L5 SUM1&HT* Y L3 &AUX1&Y L5 
Z L3 SUM1 
Z L4 SUM2 
RETURN 

NDIM IS EQUAL TO 3 

SUM1 HT* 1*25*Y LI &Y L2 &Y L2 

SUM2 Y L2 &Y L2 

SUM2 SUM2&SUM2 

Z L3 HT* Y Ll &SUM2&Y L3 

Z Ll 0. 

Z L2 SUMl 

RETURN 

END 


**• 2 5 *Y L 3 
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uuuuuuuu 


subroutine newgg <npt» z» w » X« Y) oooio 

DIMENSION X ( 1 ) » Y ( 1 ) 00020 

00030 

SUBROUTINE NEWGN ( NPT »X » Y tX'BLK fYBLK ) 000^0 

npt *« number of points per block 00050 

X * KNOWN VALUE 00060 

Y * UNKNOWN (OUTPUT) 00070 

XBLK = BLOCK OF X VALUES 00080 

YBLK = BLOCK OF Y VALUES 00090 

00100 

IF (Z-X(l) )5*5*6 00110 

5 W=Y ( 1 ) 00120 

GO TO 10 00130 

6 DO 7 1 = 2 »NPT 00140 

IF ( Z-X( I ) >9#8*7 00150 

7 CONTINUE 00160 

I =NPT 00170 

8 W=Y ( I ) 00180 

GO TO 10 00190 

9 W=<Y(I )-Y< 1 - 1 ) )/<X( I )-X(I-in*(Z-X(I-l n+YU-1) 00200 

10 RETURN 00210 

END 00220 
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SUBROUTINE BMP I T L . N .X .Y .SLOPEO .SLOPEN .A ♦ B. C »D 00010 

DIMENSION X 100 »Y 100 *A 100 *B 100 »C 100 »D 100 ' 00020 

XN 3* L-L/3 - 2*L 00030 

XO L-l /3 00040 

DO 1 J 2 »N 00050 

A J X J -X J-l 00060 

1 D J Y J -Y J-l /A J 00070 

X2 N-2 00060 

IF XN-1 4.5.6 00090 

4 C N 3.0* SLOPEN-D N /AN 00100 

B N 0.5 00110 

K3 N 00120 

XI 1 00130 

GO TO 8 00140 

5 T 2.0* A N &A N— 1 00150 

B N SLOPEN 00160 

GO TO 7 00170 

6 T 3.0* A N &A N— 1 &A N-l 00180 

SLOPEN 0.0 00190 

7 C N-l 6.0* D N -D N-l -SLOPEN*A N /T 00200 

B N-l A N-l /T 00210 

X3 N-l 00220 

XI 2 00230 

8 DO 9 J XI. K2 00240 

X N-J 00250 

T 2.0* A X &A X&l -A K&l *B K&l 00260 

B X A X /T 00270 

9 C X 6.0* D X&l -D X -A X&l *C X&l /T 00280 

10 IF XO-l 12.13.11 00290 

11 B 1 6.0* D 2 -SLOPEO -C 2 *A 2 / A 2 * 2.0-B 2 00300 

XI 2 00310 

GO TO 15 00320 

12 B 1 SLOPEO 00330 

B 2 C 2 -B 2 *B 1 00340 

GO TO 14 00350 

13 B 1 6.0* D 3 -D 2 -A 3 *C 3 / 3,0*A 2 &A 3 * 2.0-B 3 00360 

B 2 B 1 00370 

14 XI 3 00380 

15 DO 16 J X1.X3 00390 

16 B J C J -B J *B J-l 00400 

IF XN-1 18.18.17 00410 

17 B N B N-l 00420 

C CUBIC COEFFICIENTS 00430 

18 DO 19 J 2.N 00440 

TA 6.0 * A J 00450 

TM B J-l *X J 00460 

TN X J-l *B J 00470 

TX X J * X J -X J-l -X J-l 00480 

TY X J-l * X J &X J -X J-l 00490 

A J-l B J -B J-l /TA 00500 

C J-l D J & 6 J * -TX &2.*X J-l *TN-B J-l *TY-2.*X J *TM /TA 00510 

B J-l TM-TN *3.0/TA 00520 

19 D J-l TX*TN &TY*TM /TA &Y J-l -X J-l *D J 00530 

20 RETURN 00540 

END 00550 
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CSBMVAL BEAM EVALUATION SUBROUTINE 

SUBROUTINE BMEVAL N *X » Y * VALU »L » A »B»C *D*YVALU*DER I V 
DIMENSION X 100 * Y 100 » A 100 *B 100 »C 100 *D 100 
L 0 

DO 1 J l.N 

IF X J -VALU 1*2*3 

1 CONTINUE 

C OUT OF RANGE 

L 1 
J N 

2 YVALU Y J 

DERIV VALU* 3.0*VALU*A J 62*0*8 J &C J 
RETURN 

3 IF J-l 5*5*4 

4 YVALU VALU* VALU* VALU*A J-l &B J-l &C J-l &D J-l 
DERIV VALU* 3»0*VALU*A J-l &2.0*B J-l &C J-l 
RETURN 

5 L -1 
GO TO 2 

END 
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# 

* 

* 

* 

* 

* 

* 


ZEROC 


FILL DESIGNATED AREA OF CORE WITH ZERO OR WITH 
A CONSTANT SUPPLIED IN THE CALLING SEQUENCE, 


CALLING SEQUENCE 

CALL ZEROC (FROM. TO) 

OR 

CALL ZEROC ( FROM .TO.CONST > 


WHERE-FROM-IS T HE STARTING ADDRESS 

TO-FINAL ADDRESS TO BE CLEARED 
CONST-THE CONSTANT CORE IS TO BE 

FILLED WITH, IF NOT SUPPLIED 
IN CALLING SEQUENCE. CORE 
WILL BE FILLED WITH ZEROES, 


* 


PWZERO 

START 

0 

BRO 

EQU 

0 

RR1 

EQU 

1 

BR2 

EQU 

2 

BR3 

EQU 

3 

BR4 

EQU 

4 

BR5 

EQU 

5 

BR6 

EQU 

6 

BR7 

EQU 

7 

BR8 

EQU 

fl 

RR9 

EQU 

9 

BRIO 

EQU 

10 

RR11 

EQU 

11 

RR 12 

EQU 

12 

RR13 

EQU 

13 

BR 14 

EQU 

14 

BR 15 

EQU 

15 

# 

ENTRY 

ZERO 


USING 

*.BR15 

ZERO 

SAVE 

(14.12) 


ST 

BR13.SAVE+4 


LA 

BRIO. SAVE 


ST 

BRIO. 9(0. BR13) 


L 

BR3.0 ( 0 »BR 1 ) 


L 

BR4.4 ( 0 .BR1 ) 


N 

BR3.BIGAD 


N 

BR4.BIGAD 


CLR 

BR3.RR4 


BNL 

SWITCH 

MODE 1 

TM 

4 ( BR1 ) »X'80‘ 


BZ 

NTZRO 

MODE 

A 

BR4.F0RBT 


SR 

BR4.BR3 

MORE 

C 

BR4.TW056 


BL 

LE.STN 


S 

BR4.TW056 


L 

BR5.TW056 

MONE 

S 

BR5.TW0 


STC 

BR5.M0VE+1 

MOVE 

XC 

0 ( 0 *BR3 ) .0 ( BR3 ) 


BASE REGISTER 0 


INSURE ADDRESS ONLY, 

INSURE ADDRESS ONLY, 

1ST ARG, LESS THAN 2ND ARG. 

NO. THEN SWITCH REGISTERS. 

MORE ARGUMENTS, 

YES. CALCULATE BYTES TO BE CLEARED. 
BRA EQUAL NO. OF BYTES* 

OVER 255 BYTES TO CLEAR 
YES 

REDUCE BY 256 


* 

ZEROOOOO 
ZEROOOlO 
ZER00020 
ZER00030 
ZER00040 
ZEROOO 50 
ZER00060 
ZER00070 
ZEROOO 80 
ZEROOO 90 
ZER00100 
ZER00110 
ZER00120 
ZEROO 130 
ZER00140 
ZEROO 150 
ZEROO 160 
ZEROO 170 
ZEROO 180 
ZEROO 190 
ZEROO 2 00 
ZER002 10 
ZER00220 
ZEROO 2 30 
ZEROO 240 
ZER002 50 
ZEROO 260 
ZER002 7 0 
ZEROO 280 
ZER00290 
ZER003 00 
ZERO 03 10 
ZER00320 
ZER003 25 
ZEROO 340 
ZEROO 330 
ZER00350 
ZER00360 
ZER00370 
ZER00390 
ZER00400 
ZER00410 
ZER00420 
ZER 00430 
ZER00440 
ZER00470 
ZER00480 
ZER00450 
ZEROO 460 
ZER00500 
ZER005 10 
ZER005 20 
ZER00530 
ZER00540 
ZER00550 
ZEROO 5 60 
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A 

BR3.TW056 


LTR 

BR4»BR4 


BC 

2* MORE 

retrn 

RETURN (14*12) »T 

LESTN 

LR 

BR5 * BR4 


LA 

BR4 *0 


B 

MONE 

SWITCH 

LR 

BR5 *BR3 


LR 

BR3.BR4 


LR 

BR4»BR5 


B 

MOD El 

NTZRO 

L 

BR6* 8 ( 0 »BR1) 


L 

BR6 *0(0 *BR6 ) 

ntzri 

ST 

BR6* 0 ( 0 »BR3 ) 


CR 

BR3 »BR4 


BE 

retrn 


A 

BR3 * F0RBT 


B 

NTZRI 

SAVE 

DS 

18F 

BIGAD 

DC 

X ' OOFFFFFF 1 

FORBT 

DC 

F * 4 ' 

TWOS 6 

DC 

F • 256 ' 

TWO 

DC 

END 

F»l» 


RESTORE AND RETURN 


ZER00570 

ZER0QS60 

ZER00590 

ZER00600 

ZER00610 

ZER00620 

ZER00630 

ZER00640 

ZER00650 

ZER00660 

ZER00670 

ZER00680 

ZER00685 

ZER00690 

ZER00700 

ZER007 10 

ZER00720 

ZER00730 

ZER01000 

ZERO1010 

ZER01020 

ZER01030 

ZER01050 

ZER09990 
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SECTION III 

STRESS COMPUTER PROGRAM (PWA 6098) 


A, GENERAL 

The stress computer program breaks the inducer blade into flat 
triangular elements for analysis. The program then calculates stress 
magnitude and distribution caused by pressure loading and centrifugal 
force using the matrix displacement method. 

Computer capacity limits the number of free element nodes to 150 
which is equivalent to 900 simultaneous equations. Computer time for 
handling such a problem is approximately 90 minutes . An input option is 
provided to permit analysis by subsystems. This is a conventional technique 
in which the structure is divided into a maximum of 10 subsystems with a 
total of 200 nodes (including hub nodes) . Use of the subsystem option 
reduces computing time by as much as a factor of 10 for a typical 
inducer. The program requires 180,000 bytes of core (including buffers) 
on an IBM 360 Model 75 computer. Single precision with 4 bytes/word 
and 8 bites /byte is used. Fortran IV-G, Level 1, Mod. 3 compilations 
dated March 1969 were used. 

B. INPUT DESCRIPTION 


The input to the stress computer program generally consists of: a 
physical description of the inducer, a description of the finite element 
breakup to be used, and a description of the blade pressure distribution. 


The inducer physical description and blade pressure distribution 
input are straightforward but the finite element breakup input requires 
further explanation. When preparing the finite element breakup input 
it is helpful to sketch the desired pattern as in the example of figure 1 
The following limitations should be remembered: 

1. The maximum number of free boundary nodes (on boundary 

generator lines) for the entire system is 50. The minimum 
is 3 . 


2. The maximum number of free boundary nodes per subsystem is 15. 

3. The maximum number of free internal nodes per subsystem is 15. 

4. The maximum number of nodes (fixed, free, boundary and 

internal) per subsystem is 30. 


5. The maximum number of nodes for the entire system is 200. 

6. The maximum number of elements for the entire system is 200. 
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Figure 1. Finite Element Breakup 


. FD 48167 


The computer program will reproduce the sketched elemental breakup 
properly if the following is remembered when writing the input: 

1. If generator line fl i" has !, ii" points and generator line 
"i+l has 'Viiil 11 points, then the lines forming the edges of 
the finite elements start at the first point of the generator 
with the least number of points and zig zag between the 
generator lines. The areas between generators A and B, B and 
C, D and E, etc., of figure 1 are examples. 

2. The area between the first two generator lines with the 
same number of points will be broken up as shown between 
generators F and G and G and H of figure 1. 

3. The procedure of (2) will be followed for all generators 
with the same number of points until symmetry about a 
generator is requested, as was done about generator H in 
figure 1. 

4. The altered breakup will continue for sections between 
generators with the same number of points, until symmetry 
is again requested, as was done about generator J in 
figure 1. After symmetry is again requested, the breakup 
will revert to the original pattern. 
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Unless otherwise specified, data may be input in any consistent 
set of units. The same units may be used for force and mass. Output 
will correspond to the input units used. Several examples are listed 
below: 


Input Output 


Force 

Mass 

Length 

Displacement 

Stress 

lb 

lb 

ft 

ft 

lb/ft 2 

lb 

lb 

in. 

in. 

lb/in. 

gram 

gram 

meter 

meter 

gram/meter 


Input data to be written on each card is described below. f, F" 
format data should be left adjusted in the column field and should 
contain a decimal point. "E" format data ( . 300E08) must be right 
adjusted. "I 11 format data should not contain a decimal point and should 
be right adjusted. 

Column Variable Format 

Card 1 Title Card 

1-80 Input job identification data. 

As many title cards as required may be input. 

With a 1 in column 1 the machine will read 
in another title card. Omit the 1 in column 
1 on the last title card to stop the machine 
from reading title cards. 

Card 2 


1-10 

RHO 

Specific weight of the inducer blade 
material (MASS=RH0/G) . 

F10.0 

11-20 

RFM 

Rotational speed of the inducer blade 
(revolutions per minute) 

F10 .0 

21-30 

P0ISS0 

Poisson’s ratio for the material of the 
inducer blade. 

F10.0 

31-40 

YOUNGS 

Young’s modulus of elasticity for the 
material of the inducer blade 

E10.0 

41-50 

RADGEN 

Generator line offset radius. R^ 
in figure 3 (May be 0). 

F10.0 

51-55 

NCF 

Centrifugal force option. 

15 
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Leave blank if the following approximate equation is desired 
This equation should be used where bending stresses due to gas loading 
alone are predominant. 
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z 



X ^ 

Figure 3. Geometric Parameters of Middle FD 25602A 

Surface of Inducer Blade 

Input as 1 if the following equation is desired. Use this equation 
where bending stresses due to centrifugal loads dominate. 



Column Variable Format 

55-60 NGL Total number of input generator lines. 15 

Maximum of 100. 

61-65 NGS Number of generator lines about which 15 

geometric break-up symmetry is desired. 

66-70 NGP Total number of input elemental pressures 15 

71-75 NS UBS Total number of subsystems into which the 15 

inducer blade is to be divided. Maximum of 100. 

76-80 IPRINT Intermediate print option which should be 15 

used only for the checkout of the program. 

Leave blank for no intermediate print. 
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Column 

Card 3 

1-5 

6-10 

etc. 

41-45 


71-80 


Card 4 

1-5 
6-10 
etc . 


Input as 1 for the following intermediate 
print; 

a. Elemental local membrane stiffness matrices. 

b. Elemental local bending stiffness matrices. 

c. Elemental local pressure force matrices. 

d. Elemental common centrifugal force matrices. 

e. Elemental assembled common stiffness matrices. 

Input as 2 (right adjusted with no decimal point) 
for the following intermediate print; 

a. All of the above 

b . The 6 (N + 1) coefficients for each of the 
6 (N) simultaneous equations for nodal 
deflections (only for NSUBS = 0) . 

Variable Format 

Boundary Lines and G 

LBOUND (1)- Generator line numbers which form the 15 

LBOUND (9) boundaries between adjacent subsystems 
If NSUBS - 0, leave blank. Otherwise 
LBOUND (1) is the number of the generator 
line which forms the boundary between 
subsystems I and 1+1. In the latter case 
there must be NSUBS-1 values input. 

G The gravitational constant in the appropriate FlO.O 

units. If left blank or input as 0.0, a 
value of 386.4 is used. HASS = RHO/G. 

(Symme t r y Re que sts (Opti ona 1 ) 

NCHB(l)- Numbers of the generator lines about which 15 
NCBH(NGS) geometric break-up symmetry is desired. The 
only condition allowing this request for 
break-up symmetry is that the previous 
generator line and the next generator line 
must each have the same number of points as 
does the generator line about which symmetry 
is requested that is 

NUP I ^ 1 = NUP J =NUP I+1 

Sixteen values per card, as many cards as 
needed. If NGS on Card 3 was input as 
zero or left blank, omit this card 
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Column 


Variable 


Format 


Cards 5, 7, 9, 11 Generator Line Properties (NGL Cards) 

I- 10 RAPANG(I) Wrap angle in degrees of the Ith generator F10.0 

line and d ^ in figure 4). No two adjacent 

wrap angles may be equal. All wrap angles 
must be either continually increasing or 
continually decreasing in size. 

II- 20 ZGL(I) z value at the hub of the Ith generator F10.0 

line (z^ and Z2 in figure 4). No two 
adjacent generator lines may have the same 
z value unless one of the two lean angles 
is non- zero. 

21-30 RHUB (I) If RADGEN j 0, then RHUB (I) is the F10.0 

horizontal (x-y plane) distance from the 
point where the generator line is tangent 
to a cylinder with a radius of RADGEN to 
the hub of the Ith generator . If 
RADGEN - 0, then RHUB (I) is the 
radial distance from the z-axis to 
the hub of the Ith generator. 

31-40 RTIP(I) Measured the same as RHUB (I) except that F10.0 

it is the distance to the tip instead 
of the hub of the Ith generator. 



Figure 4. Triangulation of Inducer Blade FD 25630A 
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Column 


Variable 


Format 


41-50 THHUB(I) Thickness of the inducer blade at the FIO.O 

hub of the Ith generator line- 

51-60 THTIP(I) Thickness of the inducer blade at the F10.0 

tip of the Ith generator line. Thickness 
is varied linearly from the hub to the 
tip of a generator line. 

61-65 NUP(I) Number of points on the Ith generator line 15 

which are used for the division of the 
inducer blade into triangualr elements 
These points are evenly spaced between and 
including the hub and the tip. 

66-70 NX Number of pressures on the following card(s) 15 

which describes the pressure distribution 
along the Ith generator line. The pressures 
will correspond to the points on the 
generator line which are obtained by 
dividing the line into NI-1 equal segments. 

Minimum of 2 and maximum of 15 . 

71-80 ALE AN (I) Lean angle in degrees of the Ith generator FIO.O 

line measured positive upward from the 
horizontal (x-y plane) . These are illustrated 
in figure 3. 

Cards 6, 8, 10 Inducer Blade Pressure Distribution (NGL Cards) 

I- 10 PRESSI(l)- Pressures (positive upward) which describe FIO.O 

II- 20 PRESS the pressure distribution along the Ith 

etc. NGL(NI) generator line. Linear interpolation 

between points is used. Eight values per 
card; as many cards as needed . Input 
starting with the hub and ending with the 
tip . 

Card 13 NGP Elemental Pressures -(Optional) (NGP Cards) 

These cards are used for inputting elemental pressures which cannot 

cannot be obtained from the generator line pressures. 

I- 5 JI Number of the element to which the following 15 

input pressure corresponds. 

II- 20 PRESSE(JI)- Pressure which corresponds to element FIO.O 

PRESS JI. This pressure will override the 

E(JNGP) pressure obtained from the generator line 

pressure distributions. 
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C. OUTPUT DESCRIPTION 


X, Y, Z or X COMMON, Y COMMON, 
Z COMMON 

XL, YL, or X LOCAL, Y LOCAL 
TH 

PRESSURE 

AREA 

LOAD 

U, V, W, THETAX, THETAY 

U LOCAL, V LOCAL, W LOCAL 

SIGMA X BAR, SIGMA Y BAR 
SHEAR 

PRINCIPAL SIGMA X BAR, 
PRINCIPAL SIGMA Y BAR 

PRINCIPAL THETA 

MAXIMUM SHEAR 
EFFECTIVE STRESS 

A, B, C 
KM 

KB 


Common coordinates of vertices or 
nodes of triangular elements. 

Local coordinates of vertices or 
nodes of triangular elements. 

Nodal thickness at vertices of 
triangular elements. 

Average normal pressure acting on 
triangular element. 

Area of triangular element. 

Normal uniform load acting on 
triangular element. 

Common displacements of nodes or 
vertices of triangular elements. 

Local displacement of nodes or 
vertices of triangular elements. 

Stresses at centroid of triangular 
element . 

Principal stresses at centroid of 
triangular element. 

Principal direction of principal 
stress at centroid of triangular 
element . 

Maximum shear stress at centroid 
of triangular element. 

Relative effective stress at 
centroid of triangular element* 

Bending stress coefficients. 

Triangular element local membrane 
stiffness matrix. 

Triangular element local bending 
stiffness matrix. 
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D. STRESS COMPUTER PROGRAM 
Sample Case (89 Deg Helicoid with Pressure Load) 
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RESULTING TRIANGULAR ELEMENTS 


AREA * 0.125005 

NODE NO. 

X 

ELEMENT 
PRESSURE * 0 

Y 

NO. 1 

•10000 E 

z 

02 

TH 

LOAD * 
XL 

0.12500E 01 
YL 

LA 

8 

-0.004 

1.000 

0.500 


0.1000 

0.0 

0.0 

LB 

9 

-0.007 

1.500 

0.500 


0.1000 

0.5000 

0.0 

LC 

l 

0.0 

1.000 

0.0 


q.iooo 

- 0.0000 

-0.5000 

AREA * 0.125011 

NODE NO. 

X 

ELEMENT 
PRESSURE « 0 

Y 

NO. 2 

. 10000E 
Z 

02 

TH 

LOAD - 
XL 

0 . 1250 IE 01 
YL 

LA 

1 

0.0 

1.000 

0.0 


0.1000 

0.0 

0.0 

LB 

2 

0.0 

1.500 

0.0 


0.1000 

0.5000 

0.0 

LC 

9 

-0.007 

1 .500 

0.500 


0 . 1000 

0.5000 

0.5000 


AREA * 0.125011 


ELEMENT 
PRE S SURE * 0 

NO. 3 

• l 0000 E 

02 

LOAD * 

0. 1250 IE 01 

NODE NO. 

X 

Y 

z 

TH 

XL 

YL 

LA 9 

-0.007 

1.500 

0.500 

0.1000 

0.0 

0.0 

LB 10 

-0. 009 

2.000 

0.500 

0.1000 

0.5000 

0.0 

LC 2 

0.0 

1.500 

0.0 

0.1000 

-0.0000 

-0 . 5000 


AREA * 0.125019 

NODE NO. 

X 

ELEMENT 
PRESSURE * 0 

Y 

NO. . 4 
• 13000 E 02 
Z 

TH 

LOAD * 
XL 

0. 12502 E 01 
YL 

LA 2 

0.0 

l . 500 

0.0 

0 . 1000 

0.0 

0.0 

LB 3 

0.0 

2.000 

0.0 

0.1000 

0.5000 

0.0 

LC 10 

-0.009 

2.00D 

0.500 

0.1000 

0.5000 

0.5001 


AREA * 0.125019 


E LEME 
PRESSURE * 

NT NO. 5 

0 • 10000 E 

02 

LOAD * 

0.12502E 01 

NODE NO. 

X 

Y 

z 

TH 

XL 

YL 

LA 10 

-0.009 

2.003 

0.500 

0.1000 

0.0 

0.0 
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BEND. (TIP) -0.B7210E 3*. -0. 12277E 03 0.19B23E 0A -0.91561E 04 0.31225E 03 -0.1237TE 02 -0.473A2E 04 0.93161E 0A 

TOT. (TOPI -0.87200E 0A -0. 12193E 03 0.198A0F OA -0.91557E 0A 0.31382E 03 -0.12387E 02 -0.A73A8E 0A 0.93166E OA 

BEND . ( BOT I 0.87210E OA 0.I2277E 03 -0.19823E OA 0.91S61E 0A -0.31225E03 -0.I2377E 02 0.A73A2E 0A 0.931A1E 0A 

TOT. (BOT) 0. 8 722 IF OA 0.12362E 03 -0.19806E 0A 0.9156AE OA -0.31068E 03 -0.12368E 02 0.A7335E OA 0.93156E OA 
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(CONTINUING TO ELEMENT NO. 48) 



E. STRESS COMPUTER PROGRAM LISTING 


8i 



_ C THIS IS THE MAIN PROGRAM FOR THE INDUCER STRESS PROGRAM -DECK 6098MAIN0001 

C __ MAIN0002 

COMMON X _ I .200) , Y ( 200) , l ( 200) , TH t 200) ,MAINC003 

1 PRE SSEI 200 1 . XL _ ( 200.3) , YL I 200,3 >_*. MAIN0004 


3 _ THHUB_ ( 100) , THTIP ( 100) , PRESSLI 100, 15 ) , EDCM ( 3.3) .MAIN0006 

A RH O . OMEGA ~, PQISSO , YOUNGS , RADGEN , _ MAIN0007 

.5 _NGENLI_, LINEJL , NPRESI 100) , NEXT ( 200,3) , NP , NT , MAIN0008 

6 _E LMSM (6,6) / AjTNiN ( 6,6 ) , ELB§M(9,9) , ABNIN(9,9) , MAIN0009 

.7 PFLGN ( 9,1 ) , CF LGN (18,1) , ELSTJF ( 1 R, 18 )_ , EC ST IF ( 18,18) , MAIN0010 

... .8 PFC_GN( 18_,J) , CFCGNI 18,1) , MEX(206,8) , IMEXI200) , FORCE! MAINOOll 

_9 2C0.6J , ALEANCIOO). MAIN0012 

COMMON / MANE t NSUBS, I.POS ( 200 ) ,NBTS ( 1 0, 1 5 ) ,NI TS ( 10, 15 ) ,N8N ( 10 ) , MAIN0013 

1 IN TN( IO) __ MAIN0014 

COMMO N / TBAR/ THBAR ( 200 )_ MAIN0015 

DEFINE FILE 1( 20 0. 3 24, U.'lRl) ,3(900, 900, U.IR3) ,4 ( 500,602 ,U , I R4 ) MAIN0016 

C SET_UP ALL ELEMENTAL AND NODAL INFORMATION . MAIN0017 

5 CALL MINI (_I PUNCH )' MAIN0018 

I F ( NSUBS .EQ. 6 ) GO TO 10 MAIN0019 

. C __ ASSEMBLE THE KAA AND_ KAB PORTIONS OF THE COMMON STIFFNESS MATRIX MAIN0020 

C FOR EACH SUB-SYSTEM . ' ' MAIN0021 

CALL ASSEM1 __ _ _ ' MAIN0022 

C . .ASSEMBLE THE KBA AND p¥-l PORTIONS OF THE COMMON STIFFNESS MAIN0023 

C MATRIX FOR EACH SUB-SYSTEM . MAIN0024 

CALL ASSEM2 _ MAIN0025 

If ( NSUBS .LT. 0 ) GO TO 5 MAIN0026 

. C._ ..CALCULATE THE SUB-SYSTEM PORTIONS OF THE SYSTEM STIFFNESS MATRIX MAIN0027 

C AND SYSTEM BOUNDA RY FORCE COEFFICIENT MATRIX . _ MAIN0028 

CALL _CALC _ _ MAIN0029 

C ASSEMBLE_ THE SUB-SYSTEM MATRICES INTO THE SYSTEM MATRIX . MAIN0030 

CALL ASSEM3 ( NBNODE ) _ MAIN0031 

C S OLVE FOR THE BOUNDARY NODE DEFLECTIONS IN THE COMMON COORDINATE MAIN0032 

C SYSTEM . __ MAIN0033 

CALL BDEFL ( NBNODE > MAIN0034 

IF ( N SUBS .LT. O') GO TO 5 ' ' MAIN0035 

_ C SOLVE FO R THE INTERNAL NODE DEFLECTIONS OF EACH SUB-SYSTEM . MAIN0036 

CALL_ ICEFL • . MAIN0037 

. C CALCULATE THE LOCAL NODAL DISPLACEMENT MATRIX (OISPLL), THE MAIN0038 

___C LOCAL _MJLMBRANE STRESS MATRIX (STRSLM) , AND THE LOCAL BENOING MAIN0039 

C StRESS MATRIX (STRSLB) , _ _ MAIN0040 

10 CALL S TRESS ( I P UNCH ) . J '“"J ' ' MATN0041 

. GO TO 5 _ MAIN0042 

END MAIN0043 



SU BROUT I NE MAIN1 < I PUNCH ) 


COMMON X 


( 200 ) 


PRESSE( 200) . X L 


3 

4 


5 

6 _ 

7 


_RAPANG(_ 100 ) 
THHUB < 100) 
RHO , OMEGA 


< 200 ) 
( 200.3) 


». _Z_ ( 2 66) ; T H 

L 200_i3I_,_ 


( 200) 


» RHUB _(_I00)_, RT IP 
* PRESSU 100,15 )., EDCM 


100 ) 

3,3) 


NT 


ZGL ( 100) 

THTIP ( 100) 

POISS O . YOUNGS L RAOGEN. j 

..N GE NL I t_ _LI NE 1 ,. NPRESUOO) , NEXT '( 200, 3) , NP" , 

-kk MSN (6,6 ) — t__AMNIN(_6, 6 ) , . ELBSM (9,9 )_ t ABN_IN(9,9) , 
_P.FLG N(9,1) , CFLGN( 1 8.1) . £LSTIF( 1 8,18) , E.CSTJFI 18,18) 

-8 PFCGN(.18,l.) , CFCGN( 18,1), HEX (200,8), IMEX(200), 

9 FORCE (200.,_6) , ALEAN(IOO) 

COMMON / MANE / NSUB S , I POS ( 2 00 > , NBTS < 1 0 , 15 ) , NI TS ( 10 ,15 ) , NBN( 10), 
.1 JNTN(IO) 

COMMON / TBAR ./. THBAR( 200) ” ' 

DIMENSION 1C0L ( 15) , NUP ( 100) , NCHB ( I 66 ) « LBOUNO( 10 ) 

SYSi (2). , S YS2 (.2 ) ' 

, J- * 8_ ». 13 , 1A , 3 , 4 , 5 , 9 , 10 , 11 , 

JL 15 . 16 , 1 7 / 

. 0ATAJSYS1 , S Y S 2 / 4H COM , 4HM0N , 4H .16', 4HCAL / 

WRITE (3*1) RHO 
WRITE (4*1) RHO 


DIMENSION SYS (2.) , 
DA TA ICOL / 1 , 2 . 


WRITE UV1) RHO _ _ _ ' ''■ " 

5 CAUL ZERO_ (_X,FORCE (200,6) ) 

C REAO_ AND PRI N T A L L JNPU T 

CALL J NPUf ( I PR I NT , NGP , NUP , NCHB , LBOUND, NCF', I PUNCH ) 

- SYS UJ = S ys.lli > __ 

SYS(2) = SYSI ( 2 ) 


IF ( NCF .EO. 0 ) GO TO 10 


S YS ( 1 ) = SYS2I 1) 

SYS ( 2 ) = SYS2 ( 2 ) * 

TRUNG^ULAT iMJPF . INDUCER BLADE AND DETERMINATION OF THICKNESS AT 
-EMH_J/ERT.EX_ AND .PRESSURi ON EACH TRIANGLE..... 


10 CALL GEOM ( NUP , NCHB , LB OUND J 


I F ( N GP .L E. 0 ) GO TO 13" 


-DQ.-JJL.I. ?...L,.tiGP 

LI REA P ( 5,121 J.PRESSF ( J) 

.12 FORMA T ( 1 5 . 5X , F j 0 . 0 ) 

.13 _ IF ( ( NP .GT. 200 ) '.OR. 

DO 30 I = 1 .NT 


I _NT .GT, 200 ) ..) GO TO 5 


LA = NE XT ( 1,1 ) 

LB =_NEXT_( 1 , 2 )_ 

LC = NE XT ( 1.3) 

...I.MEX_( LAJ .=_IME_X( LA )_ _♦ 1 
IMEX (LB ) = IMEJLUB) +3 
IMEX (LC) = IMEX(LC) + 


MEX ( LA, I MEX ( LA) )_ =1 
MEX(L B. IMEXJLB.) )_f I ' 

MEX (j^IJ^EXJULLL = Li „ 

CA.LCUk.AJlE _THE...D I.RECT ION COS I NE MATRIX I E DC M). FOR. A TRIANGULAR ELEMMAIN1043 

CALL OIRCO S ( LA, L B ,LC« I ) MAIN1Q44 

CALCULATE THE LOCAL COORDINATES 1 XL , Y L ,ZL ) FOR A TR IANGULAR ELEMENMA IN 1045 


MA IN 1001 
MAIN 1002 
, MAIN 1003 
MAIN 1004 
.MAIN 1005 
, MA IN1006 
MAIN1007 
MAIN1008 
MAIN1009 
. MAIN 1010 
MAIN 10 1 1 
MAIN1012 
MAIN1013 
MAIN1014 
MA IN 101 5 
MAIN1016 
MAIN " 
MAIN1017 
MAIN1018 
MAIN 

MAIN1019 
MAIN1020 
MAIN 1021 
MAIN1022 
MAIN 1023 
MAIN1024 
MAIN 

.MAIN 

MAIN 

MAIN 

MAIN 

MA IN 1025 
MA IN 1026 
MA I N 1027 
MA IN 1028 
MAIN1029 
MA IN 1030 
MAIN1031 
MAIN 1032 
MA IN 1033. 
MAIN 1034 ' 
MAIN 1035 
MAIN 10 36 
MAIN1037 
MAIN 1038 
MAIN 1.0 39 
MAIN 1040 
MA IN 1041 
MA IN 1042 


C 


C ALL LCOORD (LA.LB.LC .I) ~ 


-CALCUL ATE. THE. jjE_M_BRANE _ST I F F NE S S MATRIX JELMSM). FOR A TRIANGULAR 
ELEMENT IN THE LOCAL COORDINATE, SYSTEM (XLiYL_,ZL> 

CALL MEMSTF ( LA .LB.LC. I ) “ ' ‘ 3"" 

-CALCULAJE_ T HE_BE NO I NS_SX^F_NE S S MATRIX (ELBSM) FOR A TRIANGULAR 
ELEMENT IN THE LOCAL COORDINATE SYSTEM (XL.YL.ZL) 


MA IN 1046 
MAIN 1047 
MAINL048 
MAIN 1049 
MA IN 1050 
MAIN 1051 


-S3 



n n n n non noon 


14 

C 


20 


25 


24 


15 


26 

30 


35 


CALL BEnJSTF ( L A t L B » L C » I ) MAIN 1052 

IF { IPRINT .06. I ) M A I N 1 0 5 3 

LWRITE 16*14) ( CELMSMt J,K) ,K=i r 6) , J=i,6), I ( EL8SM ( J,K ) ,K=i *9 ) , J= l , 9 ) MA I N 1054 


FORMAT ( 1HI/45X,2HKM / 6 { 10X , 6E 14 . 6/ ) / /65X , 2HKB / 9 ( 1X,9E14.6/)) 


ASSEMBLE LOCAL STIFFNESS MATRIX < EL ST IF) FOR A TRIANGULAR ELEMENT 
CO 20 J = 1,6 
00 20 K 1,6 

ELSTIFt ICQLU), ICOL(K) ) = E L M S M ( J , K ) 

DO 25 J = 1,9 
CO 25 K = 1,9 

ELSTIFMCOH J+6) , ICOLtK+6) ) = ELBSM ( J , K ) 

CALCULATE THE LOCAL GENERALIZED PRESSURE FORCE MATRIX (PFLGN ) FOR 
A TRIANGULAR ELEMENT 
CALL NPFORC ( I i 

CALCULATE THE COMMON GENERALIZED CENTRIFUGAL FORCE MATRIX (CFLGN ) 

FOR A TRIANGULAR ELEMENT 
CALL NCFQRC ( LA, LB ,LC, I , NCF ) 

IF ( IPRINT .GE. 1 ) WRITE (6,24) PFLGN , SYS , CFLGN 
FORMAT ( //20X,39HL0CAL GENERALIZED PRESSURE FORCE MATRIX /9E12.4 

1 / / 20 X , 2A4 , 36HGENERAL IZED CENTRIFUGAL FORCE MATRIX /9E12.4/ 

2 9E12.4 ) 

CALCULATE THE STIFFNESS MATRIX (ECSTIF), NODAL PRESSURE FORCE 
MATRIX (PFCGN.lt AND NODAL CENTRIFUGAL FORCE MATRIX (CFCGN) OF A 
TRIANGULAR ELEMENT IN THE COMMON COORDINATE SYSTEM <X,Y,Z) . 

CALL COMSTF ( I , NCF ) 

ECSTIF 

.GE. 1 ) WRITE (6,15) 

// 25X , 55HC0MM0N COORDINATE SYSTEM TRIANGULAR ST I FFNESSMA I N10 79 

MAIN 1080 

.GE. 1 ) WRITE (6,26) ( ( ECSTIF ( J , K ) , K«I ,18), J- 1,18) 

FORMAT ( //ISC 10E12.4/8E12.4/ ) i 

ADD VALUES OF PFCGN AND CFCGN WHICH ARE COMMON TO A COMMON NODE . 

CALL ADDF ( I ) 

PRINT GEOMETRIC BREAK-UP AND ASSOCIATED PROPERTIES . 

CALL PRINT 1 

IF ( NSU6S .GT. 0 ) RETURN 

SOLVE FOR THE NODAL DEFLECTIONS (DISPL) IN THE COMMON COORDINATE 
SYSTEM . 

CALL OEFL ( IPRINT ) 

IF ( NP .LE. 0 ) GU TU 5 
RETURN 
END 


WRITE I1U) 
IF ( IPRINT 
FORMAT ( 1H 
l MATRIX ) 
IF ( IPRINT 


MA I N 10 55 
MAIN1056 
MA I N 105 7 
MAIN 1058 
MA I N 1 0 59 
MAIN1060 
MAIN 1061 
MAIN 1062 
MAIN 1063 
MAIN 1064 
MA I N 1065 
MAIN 1066 
MA I N 1 067 
MAIN 1068 
M A I N 1069 
MAIN 10 70 
MAIN1071 
M A I N 1 0 7 2 
MA IN 107 3 
MAI N 1074 
MAIN 1075 
MAIN1076 
MA I N 1077 
MAI N 1078 


MAIN 108 1 
MA 1 N 1082 
MA I N 1083 
MA IN 1084 
MA IN 1085 
MAIN 1086 
MAIN1087 
MAIN1088 
MAIN 10 89 
MA I N 1090 
MA IN 1091 
MA IN 1092 
MAIN 109 3 





^SUBROUTINE INPUT { I PR I NT* NGP, NUP , NCHB , L BOUND * NCF * I PUNCH ) INPUTOOl 

G READ AND PR I NT ALL INPUT INPUT002 

C_ INPUT003 

COM MON X ( 200 ) _* Y ( 200) * Z C 200) , TH ( 200) *INPUT004 

1 PRESSE ( 200) * XL ( 200*3) * YL ( 200*3) , INPUT005 

2 RAPANGI 100) * ZGL ( 100) * RHUB { 100) , RTIP ( 100) * INPUT006 

3 _ _ THHUB < 100) , THTIP ( 100) , PRESSLMOO* 15 ) , EOCM ( 3*3) ,INPUT007 

4 RHO * OMEGA * POISSO , YOUNGS * RADGEN , INPUT008 

5 NGENLI * LINE1 , NPRES(IOO) , NEXT ( 200*3) , NP , NT , INPUT009 

6 ELMSH ( 6*6 ) AMNINC6*6) , ELBSM(9*9) * ABNIN(9,9) * INPUT010 


7 PFLGN (9*1) * CPLGNI 1 8 * l ) , ELSTIF C 18*18 ) , ECSTIF < 18, 18 ) , INPUTOll 

INPUT012 
INPUTOI 3 
INPUT014 
INPUT015 
INPUTOI 6 
INPUTOi 7 
I NPUT018 
INPUT019 
INPUT020 
INP.UT.021 
INPUT022 
INPUT023 
INPUT024 
INPUT025 
I N PUT 026 
INPUT027 

_ INPUT028 

1 NSUB S * I PR I NT * LBQUND * I PUNCH * G ? " INPUT029 

25 FORMAT (3Fi0.d* E 1 0 • 0 , F 10 • 6 * 6 1 5 / 1 015, 1 5 X* 1 5 , FI 0. 0 ) INPUT030 

JFLj G .EQ. 0.0_) G = 386.4 

WRITE (6,26) NSUBS*NCF *LBOUND* I PUNCH INPUT031 

26 FORMA T ( // 10X, 20HNO. OF SUB-SYSTEMS = 1 3 , 7X* 27HCENTR IFUGAL FORCE 0INPUT032 

1PTI0N = 12/ 1 OX* 4 7H SUB- SYSTEM BOUND ARISES FORMED BY GENERATOR LINES INPUT033 

INPUT034 
INPUT035 
INPUT036 
I NPUT037 
INPUT038 
INPUT039 
INPUT 040 
INPUT 04 l 

30 FORMAT (// 10X * 10HDENS TTY = F6.4*5X,4HG = , E12 .4 , 5 X* 6HRPM = Fl0.lt 5X1 NPUT042 


lj_l_8HP0ISS0N»S RATIO * F 5 . 3 * 5 X * 18H YOUNG • S MODULUS = E12.4 //10X* INPUT043 

2_26HN0.„0F GENERATING LINES = 14 * 5 X , 40HN0. OF SYMMETRY CHANGES REQINPUT044 

3UESTE6 = 13 //i0 X*31HGENERAT0R LINE OFFSET RADIUS = F9. 3 // INPUT045 

4 IPX* I 5*2X*23HINPUT ELEMENT PRESSURES //) INPUT046 

_IF I^JJLNJEl ..EQ.. 6 ) GO TO 32 INPUT047 

WR ITE ( 6 * 3JL)_(NCHB (II , 1=1*1 1 NEl ) INPUT048 

31 FO RMAT ( jO X* 38 H SYMMETRY CHANGE ABOUT GENERATOR L INES 1515/) INPUT049 

3 2 R HO = RHO / JG„ INPUT050 

OMEGA y RPM » 3.14159265 / 30.0 __ INPUT051 

KOUNT = 0 INPUT052 

WRITE (6*5) _____ - - - " INPUT053 

DO 45 I = 1, NGENLI . _ INPUT054 

REAP (5*35) RA PANG1I ) * ZGL ( 1 ) * RHUB ( I ) ,RT IP ( I) * THHUB ( I) *THTIP( I )* INPUT055 

1 NUP ( I ) * N * ALLAN ( I ) _ _ INPUT056 

35 FORMAT ( 6F 10. 0* 2 15 ,F 10 . 0 ) INPUT057 


2 1 0I5/10X*15HPUNCH OPTION = *15) 

JLF (_ LINEJL.GT. 0 ) READ 15*27 ) ( NCHB t l ) * 1 = 1 , LINE! ) 

27 FO RMAT (161.5) 

_pg.29_j = 1,100 

IF [ NCHBJ I_)_ •_G.T 2 __0 ) GO TO 29 

NCHB( I ) = NGENL I ♦ J _ 

29 iPNTLNUE 1 ... . , , 

WRITE (6*30_)RH0*G, RPM, POISSO* YOUNGS *NGENLI , LINE!, RADGEN, NGP 


8 PFCGN (18*1) * CFCGN (18*1) * MEXC 200*8), IMEX(200), 

9 FORCE (200*6) * ALEAN( 100) 

COMMON / MANE / NSUB S * I POS ( 200 ) * NBTS ( 1 0, 15 ) * NI TS ( 10 * 15 ) , NBN ( 10 ) * 
1 INTNUO) 

DIMENSI ON NUP (100) , NCHB (100), LBOUNDflOJ 

REAL TITLE U8) 
ji WRITE (6,5) 

5 _ FORMAT _( 1H1/35H0 INDUCER STRESS PROGRAM - DECK 6098 //) 

CALL DATE ( BMONTH* DA Y* YEAR ) 

WRITE (6*7) BMONTH, DAY*YEAR 
7 FORMAT ( 6H D ATE * A2 * 1H/ * A2 * 1H/ * A2 / / ) _ __ 

10_ „READ_(5* 15* END=50 ) NT, TITLE 
15 FORMAT (li_, 18A4) 

WR_ITE (6,20) TITLE 
20 FORMAT (_5X,18A4 /) 

IF ( NT .GT. 0 ) GO TO 10 

READ (5*25) RHO* RPM, POISSO* YOUNGS, RADGEN* NCF *NGENL I ,LINE1 * NGP, 


85 



3 7 

39 

40 


4b 

50 

55 


NPRESt I ) = N INPUT058 

READ (5*37) ( PRE SSL ( I » J ) * J = 1 *N ) INPUT059 

FORMAT (8F10.0) INPUT060 

WRITE (6,39) I INPUT06 i 

FORMAT ( 30X.22HGENERAT0R LINE NUMBER I 3, 5X , 1 6H ( ANGLES IN DEG.) /) INPUT062 
WRITE (6*40) RAP ANG( I ) , ZGL (1 ) , ALEAN( I ) #RHUB( I ) ,RTI P( I ) * THHUB ( I ) • INPUT063 

1 T HT I P ( I ) ,NUP( I ), NPRESt I ) * ( PRESSL < I * J ) , J*i *N) INPUT064 

FORMAT ( 5X , I 3HWRAP ANGLE = FI2.6,5X, 7HZHUB * F7. 3 ,5X , I2HLE INPUT065 

IAN ANGLE =F12.6, 5X,I3HHUB RADIUS = F8.4,5X, l 3HT IP RAOIUS = INPUT066 

2 F8.4/ 5X , l 6HHUB THICKNESS = F 7.4 , 4X , 16HT IP THICKNESS * F7.4,4X, INPUT067 

3 16HNC. OF POINTS * I2 f 9X, INPUT068 

419HN0. OF PRESSURES = 13/ 40X, 10HPRESSURES /iOX* I0F12.4/ IOX* 5 FI2 . 4 INPUT069 

5 //) I NPUT070 

KOUNT = KOUNT «• l INPUT07I 

IF ( KCUNT .EQ. 8) WRITE (6,5) INPUT072 

IF (KOUNT ,EQ. 8) KOUNT * 0 INPUT073 

ALE AN ( I ) - ALEAN(I) * 0.0174533 INPUT074 

RAPANG(I) = RAPANG(I) * 0.0174533 INPUT075 

GU TO 55 I NPUT076 

STOP INPUT077 

RETURN I NPUT078 

ENO INPUT079 
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>0 oc VJ1 -f* U) *0 


C 

c 

c 


SUBROUTINE GEOM (NUP » NCHB » LBOUNO ) 

TRI ANGULATION OF INDUCER BLADE AND DETERMINATION UF THICKNESS AT 
EACH VERTEX AND PRESSURE ON EACH TRIANGLE . 

COMMON X < 200) , Y < 200) , l ( 200) , TH ( 200) 

1 PRESSE ! 200) , XL ! 200,31 , YL ! 200,3) , 

RAPANG! 100) , ZGL < 100) , RHUB C 100) , RTIP ! 100) 
THHUB ! 100) , THTIP C 100) , PRE SSL! 100, 15 ) ,EDCM I 3,3) 
RHO , OMEGA , POISSO , YOUNGS , RAOGEN , 

NGENLI , LINE1 , NPRESI100) , NEXT ! 200,3) , NP , NT , 
ELMSMt 6,6 ) , AMN IN ! 6,6 ) , ELBSM!9,9) , ABNIN!9,9) , 

PFLGN (9,1) , CFLGN { 18,1) , * ELSTIF (18 , 18 ) , ECST I F C 18 , 18 ) 
PFCGN ( 18,1) , CFCGN ( 18,1), MEX(200,8) , IM£X!200>, 

FORCE! 200,6 ) , ALEAN ( 100 ) 

COMMON / MANE / NSUBS, I POS! 200 ) , NB TS ( 1 0, 15 ) , NITS ( 10 , 15 ) , N8N ( 10 ) , 
l INTNUO) 

DIMENSION PRESNI 200 ) , NUPIiOO) , NCHB(IOO), LBOUNO! 10) 

ICHB = 1 
KOUNT = -I 
IPOSm * -1 
L IP 1 = 0 
LIP2 = 0 
LSUB = 1 
NP 1 * l 
NT ■* 0 
NP = NUP 1 1 ) 

NS = NGENLI - 1 

DO 90 I * l, NS 

NTl = NUP* I ) ♦ NUP M +1 1 - 2 

IF < I .NE. 1 ) GO TO 15 

LINE = NUP ( I ) 

DR = 0.0 

IF ! LINE .EQ. 1 ) GO TO 1 

DR = ! RTIP! I ) - RHUB! I) ) / FLOAT! LINE - 1 ) 

RADIUS = RHUB! I) - DR 
SINA = SIN! RAPANG ! I ) ) 

COS A = COS! RAPANG!!) ) 

T ANL = TAN < ALEAN! I) ) 

ORP = ( RT1PI1) - RHUB 1 I ) ) / FLOAT! NPRESU) - 1 ) 

LINE = NUP! I) 

DO 10 J = 1 , L I N E 

IF ( J .EQ. 1 ) GO TO 2 

KOUNT = KOUNT ♦ 1 

IPOS! J) = KOUNT 

LI P l = LIPl + 1 

NITS! LSUB, UP! ) = J 

RAOIUS = RADIUS + OR 

Z(J) = ZGL ! I ) + ! RADIUS - RHUB U ) ) * TANL 

X!J) = RAOGEN * COS A - RADIUS * SINA 

Y!J) = RAOGEN * SINA + RADIUS * COSA 

THU) = THHUB! I) + ! THTIP (I.) - THHUB (I) ) * ( RADIUS - RHUB!I) 

1 / ! RTIP! I ) - RHUB! I ) ) 

IF ( TH ! J ) .LT. 0,0 ) THU) = 0.0 

J1 = ( RADIUS - RHUB! I) + 0.0001 ) / DRP 

J 1 = J 1 + l 

IF ( Jt .GF. NPRES ! I ) ) GO TO 5 

PRESNU) = PRE SSL ! I , J 1 ) + ! PRE SSL ( 1 , J 1 + 1 ) - PRESSL(I,Ji) ) * 

1 ! RADIUS - DRP * FLOAT! J 1 - 1 ) - RHUB! I) ) / DRP 


GEOMOO 10 
GE0M0020 
GE0M0030 
GEOM0040 
, GEOMOO 50 
GEOM0060 
, GEQM0070 
, GEOM0080 
GEOM0090 
GE0M0100 
GEOMOl 10 
GEOMO120 
GEOM0130 
GE0M0140 
GE0M0150 
GEOM0160 
GEOMOl 70 
GEOMOl 80 
GEOMOl 90 
GE0M0200 
GEOM02 10 
GEOM0220 
GE0M0230 
GEO MO 2 40 
GEOM02 50 
GEOM0260 
GE0M0270 
GEOM 02 80 
GEOM0290 
GEOM0300 
GEOM0310 
GE0M03 11 
GEOM0312 
GE0M0320 
GEOM0330 
GE0M0340 
GEOM0350 
GE0M0360 
GEOM0370 
GE0M0380 
GEO MO 390 
GE0M0400 
GE0M0410 
GE0M0420 
GEOM0430 
GE0M0440 
GE0M0450 
GEQM0460 
GEOM0470 
GEOM0480 
) GE0M0490 
GE0M0500 
GEOM0510 
GE0M0520 
GEOM0530 
GEOM0540 
GEOM0550 
GE0M0560 


*7 



5 

10 

15 


16 


17 


) / FLOAT ( LINE - 1 ) 

0 

) / FLOAT ( NPRESU + l) - 1 ) 


GO TO 10 

PRESN(J) = PRESSLt I, NPRESU)) 

CONTINUE 
LINE = NOP ( l+l) 

DR = 0.0 

IF ( LINE .EQ. I ) GO TO 16 
DR = ( RTIPU+1) - RHUBU + 1) 

IF ( 1 + 1 .EQ. L BOUND (LSUB) ) LIPl 
RADIUS = RHUBU + 1) - DR 
DRP = ( RTIPU + 1) - RHUBU + l) 

J2 = NP ♦ 1 

J3 * NP + NUP ( I ♦ 1 ) 

SIN A 55 SIN! RAPANG ( I + 11 ) 

COSA = COS ( RAPANG [ I+I > ) 

TANL = TAN( ALEANI 1+1) ) 

IPOSIJ2) = -1 

DO 25 J = J 2 « J 3 

IF ( J . EQ. J 2 ) GO TO 17 

KOUNT * KOUNT + 1 

IPOSIJ) = KOUNT 

IF ( NSUBS .EQ. 0 ) GO TO 17 

IF I (LSUB .EQ. 1) .AND. <1+1 .LT. L BOUND ( 1 ) ) 

IF ( (LSUB .EQ. 1) .AND. (1 + 1 .LT. L BOUND (1) ) 

IF ( LSUB .EQ. NSUBS ) LIP l = LIPl ♦ 1 

IF ( LSUB .EQ. NSUBS ) NT TSI LSUB • L IP U = J 


) LIPl = LIPl ♦ 1 
) N I TS ( L SUB » L 1 P 1 ) 


IF 

t (LSUB .NE. 

1) 

.AND. 

(LSUB 

•NE. NSUBS) 

• AND. 

« 1*1 *NE 

1 

LBOUND ( LSUB ) ) 

) 

LIPl 

= LIPl 

+ 1 



IF 

( (LSUB .NE. 

1) 

.AND. 

(LSUB 

.NE. NSUBS) 

• AND. 

(1+1 .NE 


1 L BOUND! LSUB ) ) ) N 1 T S ( LSUB ,L IPU = J 
IF ( l+l .NE. L BOUND ( LSUB ) ) GO TO 17 
L I P 2 = L I P2 ♦ 1 
NBT S! LSUB » L IP 2 ) =J 
III = L l P 2 

IF ( LSUB .NE. 1 ) K = 

IF ( LSUB .NE. 1 ) III 
NBT S( LSUB+ 1 f III) = J 
RADIUS = RADIUS + OR 


L BOUND! LSUB- 1 ) 
= III - NUP(K) 


+ l 


TANL 


Z(J) = ZGL ( I +1 ) + ! RADIUS - RHUBU + 1) ) * 

X ( J ) = RADGEN * COSA - RADIUS * SINA 

YU) = RADGEN * SINA + RADIUS * COSA 

TH{ J ) = T HHU81 I + 1 ) + ( THTIPU + l) - THHU8 ( I +1 ) ) * ( RADIUS - 

1 RHUBU + 1) ) / ( RTIPU + 1) - RHUB ( .1 + 11 > 

JL = ( RADIUS - RHUBU + 1) ♦ 0.0001 ) / DRP 
Jl = Jl + 1 

IF ( T H ( J ) .LT. 0.0 ) TH ( J ) =0.0 
IF ( Jl .GE. NPRESU + l) ) GO TO 2 0 

PRESN(J) = PRCSSL ( I + 1 » J 1 ) + ( PRESSLU + 1 , J l + i ) - PRESSL ( I + 1 » J1 ) 
* ! RADIUS - DRP * FLOAT (Jl-ll - RHUBU + 1 1 ) / DRP 


1 


20 

25 


26 


= PRESSLt I + l, NPRESU + l) ) 

.NE. LBUUND(LSUB) ) GO TO 26 


GO TO 25 
PRESNt J) 

CONTINUE 
IF t 1+1 
LSUB = LSUB + 1 
K = L BOUND ( L SUB- 1 ) 
LIP2 = NUP(K) - l 
Jl = NT ♦ l 
J 2 = NT + NT 1 
NB = 0 


GEOM0570 
GEOM0580 
GE0H0590 
GEOH0600 
GE0M060 l 
GEOM0602 
GE0H0610 
GE0M0620 
GE0M0630 
GEOH0640 
GEOM0650 
GEQM0660 
GE0M0670 
GE OH 0680 
GEOM0690 
GEO MO 7 00 
GEQM0710 
GEOM0720 
GEOM0730 
GE0M07A0 
GE0M0750 
GEOM0760 
= JGE0M0770 
GE0M0780 
GE0M0790 
GEOM0800 
GE0M0810 
GE0M0820 
G60M083C 
GEOM0840 
GE0M0850 
GEOM0860 
GEOHO870 
GEQM0880 
GEOM0890 
GEQM0900 
GE0M09 10 
GEOM0920 
G60H0930 
GE0M09A0 
GE OH 0950 
GEOM0960 
GE0M0970 
GEOM0980 
GE0M0990 
GEOH 1000 
) GEOMIOIO 
GEOH 1020 
GE0M1030 
GEOMIOAO 
GEOM1050 
GEOM1060 
GEOM1070 
GEOM1080 
GE0H1090 
GEOMltOO 
GEOMliiO 
GEOM1120 
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on no 


K * 0 
N81 = -2 
NPTI = NUP ( t ) 
NPT 2 * HUP t 1*1) 


IF 

(NPTI 

•EQ. NPT 2) 

GO 

TO 

27 


IF 

(NPT2 

- NPTI 

• EQ. 

X) 

GO 

TO 

275 

IF 

(NPTI 

- NPT 2 

• EQ. 

1) 

GO 

TO 

270 

IF 

(NPT2 

- NPTi 

• GT. 

1) 

GO 

TO 

265 


BOTTOM GENERATOR HAS AT LEAST TWO MORE NODES THAN THE TOP 
GENERATOR. 

DO 264 J = J 1 1 J 2 
K = K ♦ I 
L = MOD ( Kf 3 ) 

IF (L .EQ. 0) L = 3 
GO TO 1261, 262, 263), L 

261 NB1 - NB1 ♦ 2 
NEXT ( J , 1 ) * NPi + NB1 
NEXT ( J , 2 ) = NP1 ♦ NB1 + 1 
NEXT! J , 3 ) = NP ♦ NB1 / 2 ♦ 1 
GO TO 264 

262 NEXT C J , 1 ) = NEXTU-1,31 
NEXT ( J , 2 ) = NEXT ( J , 1 ) ♦ 1 
NEXT! J , 3 ) - NEXT ( J-l ,2 ) 

GO TO 264 

263 NEXT ( J , 1 ) * NEXT(J-1,3) 

NEXT U, 2 ) = NEXT ( J , l ) + 1 
NEXT U , 3 ) = NEXT (J-l ,2 ) 

264 CONTINUE 
GO TO 85 

TOP GENERATOR HAS AT LEAST TWO MORE NODES THAN 
THE BOTTOM GENERATOR. 

265 DO 269 J * Jl, J2 
K - K + 1 
L = MGD(K,3) 

IF (L .EQ. 0) L = 3 
GO TO (266,267,268), L 

266 NB1 = NB1 + 2 
NEX T ( J , L ) * NP ♦ N81 + 1 
NEXT (J, 2 ) = NP * NB1 ♦ 2 
NEXT (J, 3) = NP1 ♦ NB1 / 2 
GO TO 269 

267 NEXT { J , 1 ) = NEXT { J- 1 , 3 ) 

NEXT ( J , 2 ) = NEXT ( J » 1 ) ♦ l 
NEX T ( J , 3 ) = NEXT ( J-l , 2 ) 

GO TO 269 

268 N EX T ( J , l ) = NEXT (j- 1,3) 

NEXT ( J , 2 ) = NEX T( J ,1 ) ♦ 1 
NEXT ( J, 3 ) = NEXT (J-l, 2) 

269 CONTINUE 
GO TU 83 

C BOTTOM GENERATOR HAS ONE MORE NODE THAN THE TOP GENERATOR. 

270 NEXT (J 1,1) = NP 1 
NEXT (J 1,2) = NP 1 + i 
NEXT (J l, 3) - NP + 1 

IF (Jl .EQ. J 2 ) GO TU 85 

Jl 1 ■ « Jl * 1 

CO 27 1 J = J 1 1 , J 2 

NEX T ( J , 1 ) = NEXT (J-l ,3) 


GE0M1130 
GEQMU40 
GEOM 11 50 
GE0M1 l 60 
GE0M1170 
GE0M1180 
GEOM 1190 
GE0M1200 
GE0M1210 
GEOM 1220 
GE0M1230 
GE0M1240 
GE0M1250 
GE0M1260 
GEOM 12 70 
GEQM1280 
GEOM1290 
GE0M1300 
GE0M1310 
GE0M1320 
GEOM1330 
GEOM1340 
GEOM1350 
GE0M1360 
GEQM1370 
GEOM1380 
GEQM1390 
GEQM1400 
GE0M1410 
GEOM1420 
GEOM1430 
GE0M1440 
GE0M1450 
GE0M1460 
GEOM1470 
GE0M1480 
GEOM1490 
GE0M1500 
GEOM1510 
GEQM1520 
GEOM 15 30 
GE0M1540 
GEOM 1550 
GE0M1560 
GEOM 1570 
GEOM1580 
GEOM 1590 
GE0M1600 
GEOM 16 10 
GEOM 1620 
GEOM 1630 
GEOM 1640 
GEOM 1650 
GEOM 1660 
GEOM 1670 
GEOM 1680 
GEOM 1690 
GEOM 1700 
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NEXT ( J ,2 ) * NEXT<J,i)+l 


GEOM1710 

271 

NEXT ( J , 3 ) = NEXT (0-1*2) 


GE0M1720 


GO TO 85 


GE0M1730 


TOP GENERATOR HAS ONE MORE NODE 

THAN THE BOTTOM GENERATOR. 

GEOM1740 

275 

NEXT ( J 1 9 1 ) * NP ♦ 1 


GE0M1750 


NEXT ( J l ,2 ) = NP + 2 


GE0M1760 


NEXT U 1,3) = NP 1 


GE0M1770 


IF (Jl .EQ. J 2 ) GO TO 85 


GE0M1780 


Jll = Jl > 1 


GEQM1790 


DO 276 J = Jll, J2 


GEOM 1800 


NEXT { J, 1 ) = NEXT ( J-l * 3 ) 


GEOM 1810 


NEXT! J, 21 = NEXT ( J , 1 ) + 1 


GEOM 1820 

2 76 

NEXT I J , 3 ) = NEXT I J-l , 2) 


GEOM 18 30 


GO TO 85 


GE0M1840 


SAME NUMBER OF NODES ON TOP AND 

BOTTOM GENERATORS . 

GEOM 1850 

27 

IF ( RADGEN .NE • 0.0 ) GO TO 55 


GEOM 1860 


IF ( NCHB ( I CHB > .EQ. 1 ) GO TO 40 

GEOM 1870 


IF ( I CHB .GE. 2 J GO TO 42 


GEOMl 880 

28 

DO 35 J - J 1 * J 2 


GE0M1890 


K - J - J 1 + 1 


GEOM 1900 


IF ( MOD ( K * 2 ) .EQ. 0 ) GO TO 30 


GEOM 19 10 


NB * NB ♦ 1 


GE0M1920 


NEXT { J , 1 ) = NP + NB 


GEOM 19 30 


NEXT! J, 2) = NP + NB ♦ 1 


GEOM 1940 


NEXT ( J * 3 ) = NP 1 ♦ NB - 1 


GEOM 1950 


GO TO 35 


GEOM1960 

30 

NEXT t J « l ) = NP l * NB - 1 


GEOM 1970 


NEXT I J , 2 ) = NP 1 ♦ NB 


GEOM 1980 


NEXT! J , 3 ) - NP ♦ NB > l 


GEOM 1990 

35 

CONTINUE 


GEO M2 000 


GO TO 85 


GE0M20 10 

40 

I CHB = I CHB ♦ 1 


GEOM2020 

42 

IF ( MOD (I CHB, 2) .EQ. 1 ) GO TO 

28 

GEOM 20 30 


DO 50 J = J 1 » J 2 


GEQM2040 


K = J - J 1 + 1 


GE0M2050 


IF { MODI K, 2) .EQ. 0 ) GO TO 45 


GEOM 2060 


NB = NB + 1 


GEOM2070 


NEXT ( J , l ) = NP1 + NB - 1 


GEO M2 080 


NEXT U, 2 ) = NP 1 + NB 


GEUM2090 


NEXT! J, 3 ) = NP ♦ NB 


GEOM 2 100 


GO TO 50 


GE0M21 10 

45 

NEXT ( J , 1 ) = NP + NB 


GEO M2 1 20 


NEXT U, 2) = NP + NB + 1 


GE0M2130 


NEXT! J, 3) = NP1 + NB 


GEOM2140 

50 

CONTINUE 


GE0M2150 


GO TO 85 


GE0M21 60 

55 

IF i NCHB { I CHB) .EQ. I ) GO TO 

70 

GE0M2170 


IF ( I CHB .GE. 2 ) GO TO 7? 


GEOM 2 1 80 

58 

DO 65 J = Ji,J2 


GE0M2190 


K = J - Jl + l 


GE0M2200 


IF I MODI K, 2) . EQ. 0 ) GO TO 60 


GE0M22 10 


NB = NB + 1 


GE0M2220 


NEXT I J , 1 ) = NP 1 ♦ NB - 1 


GE0M2230 


NEXT {J, 2) = NP 1 4- NB 


GE0M2240 


NEXT! J,3 ) = NP + NB 


GE0M2250 


GO TO 65 


GEOM2260 

60 

NEXT ( J , l ) = NP + (MB 


GE0M2270 


NEXT! J, 2) = NP 4- NB ♦ 1 


GE0M2280 
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NEXT ( J* 3 ) * NP1 ♦ NB 


GE0M2290 

65 

CONTINUE 


GEQM2300 


GO TO 85 


GEOM23IO 

?Q 

ICHB * ICHB ♦ l 


GE0M2320 

72 

IF ( MOOUCHB ,2) .EQ. i ) GO TO 58 


GE0M2330 


00 80 J * J1,J2 


GEOM2340 


K * J - Jl ♦ I 


GE0M2350 


IF ( MOD ( K , 2 ) .€0. 0 ) GO TO 75 


GE0M2360 


NB * NB ♦ 1 


GEOM2370 


NEXT t J, l 1 = NP ♦ NB 


GEOM2380 


NEXT ( J, 2 1 * NP ♦ NB ♦ 1 


GE0M2390 


NEXT ( J* 3 ) * NPl ♦ NB - 1 


GE0M24Q0 


GO TO 80 


GEQM24 10 

75 

NEXT! J f l ) = NPl ♦ NB - 1 


GEOM2420 


NEXT ( J , 2 ) * NPl > NB 


GE0M2430 


NEXT 1 J 9 3 1 - NP ♦ NB + 1 


GE0M2440 

ao 

CONTINUE 


GE0M2450 

65 

CONTINUE 


GEOM2460 


NPl * NP ♦ 1 


GEGM24 70 


NP = NP ♦ NUPlI+i) 


GE0M2480 


NT * NT ♦ NT 1 


GE0M249Q 


IF ( NP .LE. 200 ) GO TO 87 


GEOM2500 


WRITE ( 6 , 86 ) 


GE0M2510 

66 

FORMAT ( // 20X , 35HMORE THAN 200 POINTS 

WERE GENERATED i 

GE0M2520 


RETURN 


GE0M2530 

87 

IF ( NT .LE. 200 ) GO TO 90 


GEOM2540 


WR I TE ( 6 , 88 ) 


GE0M2550 

68 

FORMAT ( //20X, 37HMORE THAN 200 ELEMENTS WERE GENERATED 1 

GE0M2560 


RETURN 


GE0M2570 

90 

CONTINUE 


GEOM2580 


DO 95 I * I f N T 


GE0M2590 


Jl = NEXH 1,1) 


GE0M2600 


J2 - NEXT! 1,21 


GEQM2610 


J3 = NEXT (1,3) 


GEOM2620 

95 

PRESSEM) = ( PR ESN ( J I ) ♦ PRESNU2) ♦ 

PRESNIJ3) 1/3.0 

GE0M2630 


IF ( NSUBS .EQ. 0 ) RETURN 


GE0M2640 


I = L BOUND ( 1 1 


GE0M2650 


NBN { 1 ) = NUP(I) - 1 


GEOM2660 


DO 110 I = 1, NSUBS 


GEO M2 670 


IF ( I .Eg. 1 ) GO TO 100 


GE0M2680 


J * L BOUND ( I - 1 ) 


GE0M2690 


NBN ( I 1 = NUP(J) - 1 


GEQM2700 


IF ( I .EQ. NSUBS ) GU TO 100 


GE0M2710 


J = LBOUNDU) 


GE0M2720 


NRNU) = NBN (I 1 ♦ NUP(J) - 1 


GE0M2730 

100 

J2 = LBOUNDU) - 1 


GEOM2740 


IF ( l .EQ. NSUBS ) JZ = NGENLI 


GE0M2750 


Jl = 1 


GEO M2 760 


IF ( I .GT. i ) Jl = LBOUNO(I-l) ♦ i 


GE0M277O 


INTN ( I ) = 0 


GEUM2780 


DO 110 J = J L , J2 


GE0M2790 

no 

I NT N ( I ) * INTN( I ) ♦ NUP { J ) - i 


GE0M2800 


RETURN 


GE0M2810 


END 


GEOM2820 


91 



SUBROUTINE DIRCOS (L A , LB , LC » I ) 

CALCULATE THE DIRECTION COSINE MATRIX (EDCM) 


DIRCQSOl 

OF ELEMENT LOCAL AXESD IRCQS02 


COMMON 


X ( 
PRESSEt 
RAPANGI 
THHUB ( 


2 00 ) 
2 00 ) 
100 ) 
100 ) 


RHO , OMEGA , 
NGENLI , LINE l 
DOUBLE PRECISION L12 , 


! COMMON 

AXES 

(X,Y,Z) 





DIRCOS03 









DI RC0S04 

Y 

( 

200) 

t l 

( 200) , 

TH 

( 

200) 

,01 RCOS 05 

XL ( 

200,3) 

, YL ( 

200,3) , 




DIRCOS 06 

ZGL 

( 

100) 

, RHUB 

( 100) , 

RTIP 

( 

100) 

, DIRCOS 07 

THTIP 

( 

100) 

, PR E SSL ( LOO, 15) 

, EOCM 

( 

3,3) 

,01 RCOS08 

POISSO 


, YOUNGS t RADGEN , 




DIRCOS 09 

, NPRES(IOO) 

t NEXT ( 

200,3) 

t NP , 

NT 


DIRCOS 10 

SIX , 


SLY , 

SLZ • SI 

• S2 X y 

$2Y , 

S2Z , 

DIRCOS 11 









DIRCOS 12 


L 12 = 
SIX = 
S1Y * 
S1Z * 

1 

SIGN 


S2 

SORT ( ( X( LB )-X (LA ) 1**2 ♦ ( Y(L8 )~ VILA > ) **2 + t ZU8)-Z UA )) **2 >DI RCOS 13 
(Y(LB)-Y(LA)) * (Z(LC)-Z(LA) ) - ( Y( tCI-Y (LA) ) * I Z (LB) -Z ( LA) ) DIRC0SL4 
( Z ( LB )-Z (L A ) )*( X(LC )-X ( LA) > ■*- U(LC)-ZUA) ) * < X ( LB ) -X ( L A ) ) 01 RCOS 15 

( X ( LB ) * X (LA ) ) * ( Y ( LC ) - V(LA)) - (X(LC) - XCLA) ) * 0IRC0S16 


I y ( l_ 6 I - Y(L A ) ) 
* 1.0 


DIRCOS 17 
DIRCOS 18 


IF ( LC .LT. 

LB ) SIGN = -1. 

0 




DIRCOS 19 

SIX = SIX • 

SIGN 






0LRCOS20 

SlY = SLY * 

SIGN 






DIRCOS 21 

S1Z = SLZ • 

SIGN 






DIRCOS 22 

SI “DSQRT { 

S 1X**2 «• 

SI Y**2 

♦ 

SI Z**2 

) 


DIRCOS 2 3 

S2X * SlY * 

IZ(LB) - 

Z ( L A ) ) 

- 

SLZ * 

CY(LB) - YCLA ) ) 


DI RC0S24 

52 V = S1Z * 

1 X ( LB I - 

X { L A ) ) 

- 

SIX * 

(Z(LB) - Z ( L A ) ) 


DIRCOS 25 

S2Z = SIX * 

(Y(LB) - 

Y ( LA ) ) 

- 

SlY * 

( X (LB) - X (LA) ) 


DIRC0S26 

S 2 =DSQRT ( 

S2X**2 ♦ 

S2Y**2 

+ 

S2Z**2 

) 


DIRCOS27 

EDCM (1,1) = 

( X ( LB ) - 

X ( LA ) ) 

/ 

L 12 



DIRC0S28 

EDCM (2,1) = 

1YILB) - 

Y1LA ) ) 

/ 

L 12 



DIRCOS 29 

EOCM (3,1) = 

( Z ( LB ) - Z ( LA) 

) 

/ L 12 



DIRCOS 30 

EDCM ( 1,2 ) = 

S2X / S2 






01 RCOS 31 

EDCM (2,2) = 

S2Y / 52 






DI RCOS 32 

EDCM! 3,2) = 

S2Z / S2 






D I RCOS 3 3 

EDCM ( 1,3) = 

SIX / Si 






01 RCOS 34 

EDCMC 2,3 ) = 

SLY / Si 






DIRCOS 35 

EOCM( 3,3) = 

SLZ / SI 






DIRC0S36 


RETURN 

END 


01 RCOS 37 
OIRCOS38 



SUBROUTINE LCOORO ( L A, L B , LC, I ) 

DETERMINE LOCAL NODAL COORDINATES (XL,YL»ZL) OF TRI 
FROM COMMON NODAL COORDINATES <X,Y,Z) • 


LCCORDO 1 
ANGULAR ELEMENTLCG0RD02 
LC0ORD03 
LCQ0RD04 


COMMON 

X { 

200) 

t 

Y 

{ 200) 

* 

Z < 200) , TH » 

( 200) 

,LCQ0RD05 

1 

PRESSEl 

200) 

» 

XL t 

200,3) 

9 

YL ( 2 C 0 , 3 ) , 


LC00RD06 

2 

RAPANGt 

100) 

9 

ZGL 

( 100) 

» 

RHUB ( 100) , RTIP 

1 100) 

, LCQORD07 

3 

THHUB ( 

1001 

9 

THTIP 

I 100) 

9 

PRESSL ( 100 » IS), EDCM 

( 3,3) 

t LC00RD08 

4 

RHO , OMEGA 

9 

POISSO 

, YOUNGS 

, , RADGEN , 


LCOORD09 

5 

NGENLI 

, LINE1 

* NPRESt 100) 

f 

NEXT { 200,3) , NP , 

NT 

LCQORDIO 


XL ( 1 1 21* EDCM(i,U * ( X ( L B > - XILA)) + E0CM(2,1J ♦ 
l +EDCM ( 3 » I ) * Hi LB ) - Z ( L'A ) ) 

XL I I * 3 ) = EDCMfl.fl) * (XtLC) - X<LA)) + EDCM{2,1) * 
i +EDCMI3, 1) * IZILCI - Z (LA) ) 

YU 1 1 B )= EDCM( I v 2 ) * CXI LC ) - XUAU + EDCM(2,2) * 
1 +EDCM (3*2) * IZILC) - Z(LA)) 

RETURN 

END 


(YiLB) - VILA) ) LCOORD1 1 
LCOORD12 
C Yf id - Y ( LA ) > LCGQRD13 
LCQ0RD14 
IYTLC) - YC.LA) ILCOORD15 
LC00RD16 
LCOORDl 7 
LCOOR018 
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O' W U> f "0 *-• 


c 

c 

c 


IG 


lb 

?0 


SUBROUTINE MEMSTF ( L A A , LBB , LCC , I E ) 

CALCULATE THE LOCAL MEMBRANE STIFFNESS MATRIX ( F LMSM) FOR A 
TRIANGULAR ELEMENT . 


COMMON X ( 200) * V ( 200) , Z ( 2 CO) , TH ( 200) 

PKESSEI 200) , XLL ( 200,3) , YLL ( 200,3) , 

RAPANGC 100) , ZGL { 100) , RHUB ( 100) , RT I P ( 100 ) 

THHUB I 100) , THTIP t 100) , PRE SSL ( l 00 , 15 ) , EDCM ( 3,3) 

RHO , OMEGA , PUISSO , YOUNGS , RADGEN , 

NGENLl , LINE! , NPRESUOO) , NEXT I 200,3) , NP , NT , 
ELMSM (6,6) , AMNINI 6,6) , ELBSM(9,9) , ABNIN(9,9) , 
PFLGNT9, l) 

COMMON / T BAR / THBAR ( 200 ) 

DIMENSION AMN I T ( 6 , 6 ) , WM(3,6) , WMT(6,3) , EM (3,3) 

l T N 1 6 , 1 ) , ZINT (1,6) , Z 1(6,6) , 12 (6,6) 

DIMENSION YL ( 3 ) , XL(3) 

DOUBLE PRECISION ZINT , XL , YL , TERM , AMNIT , WM , WMT , EM , 
1 TN , Z 1 , 12 

DATA LA, LB # LC / 1 , 2 , 3 / 

DATA HM / 1.000,4*0.000, 1.000,2*0.000, 1.000,0. 000, 1.000,7*0*000 
DATA WMT / 1.000,8*0.000, 1.000, 3*0.000, 2*1. 000, 3*0. ODO / 

DATA AMNIT, EM, TN / 51*0.000 / 

XL (LB) = XLL (IE, 2) 

XL(LC) = XLL ( I C , 3 ) 

YL(LC) = YLL ( 1 6,3) 


TERM = YOUNGS / ( 1.0 - P0ISS0**2 ) 

EMI 1,1) ^ TERM 

EM ( 1,2) = TERM * PUISSU 

EM( 2,1 ) = E M ( 1,2) 


EM (2,2) = TERM 


EM ( 3,3) = 
AMN IN ( 1,1) 
AMN I N ( 1,3) 
AMN IN ( 2 , 2 ) 
AMN IN (.2,4) 
AMN I N ( 3, 1) 
AMN 1 N ( 3, 3) 
AMN IN ( 3,5) 
AMN IN ( A, 2) 
AMNIN( A, 6) 
AMN IN ( A , 6 ) 
AMN IN ( 5, 1 ) 
AMN IN ( 6, 2 ) 


1.0 - POISSO ) * TERM / 2.0 
= -1.0 / XL (LB) 

= - AMN IN (1,1) 

= AMN IN ( 1,1) 

= AMN IN ( 1 , 3 ) 

= ( XL(LC) - XL ( Lb ) ) / XL ( LB ) / YL ( LC ) 
= - XL (LC ) / XL(LB) / YL(LC) 

= 1.0 / YL(LC) 

= AMN IN 13,1) 

= AMN 1 NT 3,3) 

= AMN IN (3,5) 

= 1.0 

= 1.0 


DU 10 I = 1,6 


Z INK 1,1 ) = 0.0 

DO 10 J - 1,6 

AMN IT ( I , J) = AMN IN ( J , I ) 


TN jt 1,1) = 

TH( LAA ) 

TN( 3,1 ) = 

TH ( LBB) 

T N ( 5 , 1 ) = 

T H ( L CC > 

CALL ZImI 1 

( 1 1 , Z I N T ) 

DO 15 J = 

1 , 6 

ZK 1,J) ^ 

0.0 

CU 15 K = 

1,6 

Zl(l,J) = 

Z 1 ( 1 , J ) + Z I it ( 1 , K ) * AMN I N ( K , J ) 

ZZ i l, i ) = 

0.0 

CO 2U K = 

1,6 

l?\ 1,1) = 

/?( 1,1) + Zl( 1 , K ) * TN ( K , 1 ) 


MEMSTF01 
MEMSTF02 
MEMSTF03 
MEMSTF04 
,MEMS TFQ5 
MEMSTF06 
, MEMSTF07 
,MEMSTF08 
MEMSTF09 
MEMSTF10 
MEMSTF 11 
MEMSTF12 
MEMSTF 13 
, MEMSTF 14 
MEMSTF15 
MEMSTF 16 
MEMSTF 17 
MEMSTF 18 
MEMSTF 19 
/ MEMSTF 20 
ME MS T F 2 1 
MEMSTF 22 
MEMSTF23 
MEMSTF24 
MEMSTF25 
MEMSTF26 
MEMSTF27 
MEMSTF 2 8 
MEMSTF29 
MEMSTF 30 
MEMSTF 31 
MEMSTF 32 
MEMSTF33 
MEMSTF 34 
MEMSTF 35 
MEMSTF36 
MEMSTF37 
MEMSTF 38 
MEMSTF 39 
MEMSTF40 
MEMSTF41 
MEMSTF42 
MEMSTF 43 
MEMSTF44 
MEMSTF45 
MEMSTF46 
MEMSTF47 
MEMSTF 4 8 
MEMSTF49 
MEMSTF 50 
MEMSTF5 1 
MEMSTF52 
MEMSTF53 
ME MS T F 54 
MEMSTF 55 
MEMS TF 56 
MEMSTF57 
MEMSTF 58 
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T HBAR ( IE ) 

= t TH(LAA) + TH t L8B ) + TH( LCC ) ) / 3.0 

MEMSTF59 


00 25 I 

* 

1*6 



MEMSTE60 


CO 25 J 

= 

1*3 



MEHSTF61 


Z 1 ( l * J ) 


0.0 



MEMSTF62 


00 25 K 

= 

1*3 



MEHSTF63 

25 

Zl( I,J) 

s 

Zl< I, J) 

♦ 

Z2t 1*1). * HNTUtKI * EMI K, J ) 

MEMSTF64 


DO 30 r 

X 

1*6 



MEMSTF65 


DO 30 J 

X 

1*6 



MEMSTF66 


Z2< I.J) 

X 

0.0 



HEMSTF67 


00 30 K 

X 

1.3 



MENSTF68 

30 

IZi I , J ) 

X 

Z 2 ( l v J-» 


Zl( I,K) * WMIK.J) 

MEMSTF69 


DO 35 I 

a 

1.6 


HEHSTFTO 


DO 35 J 

X 

1.6 



MEMSTF71 


Z1 1 I, J) 

3 

0.0 



MEHSTF72 


DO 35 K 

X 

1*6 



MEMSTF73 

35 

Zll I,J) 

X 

Z 1 ( i * J ) 

♦ 

AMN I T ( I > K ) * Z2 I K * J 1 

MEMSTF74 


DO 40 I 

2 

1,6 



MEMSTF7* 


DO 40 J 

X 

1*6 



HEMSTF76 


ELMSMI I 

• J) 

ii 

o 

• 

o 



MEMSTF77 


00 40 K 

X 

1*6 



MEMSTF78 

40 

ELMSHt I 

*Ji 

* ELMSM{ ! 

1 »J) ♦ Z1II.K) * AMNIN ( K , J ) 

MEMSTF79 


RETURN 





MEMSTF80 


END 





MEMSTF8 1 
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u o o u u u 


SUBROUTINE Z I N T 1 C IfctZ I NT ) 

USING GAUSSIAN QUADRATURE, INTEGRATE THE FOLLOWING FUNCTIONS OVER 
THE SURFACE OF THE TRIANGLE 

E ( XL » YL ) = UO 
Ft XL, Y L ) = XL 
F t XL « YL I = YL 


Z l NT 1 00 1 
ZINT 1002 
1 1 NT 100 3 
Z I NT 1004 
ZINT1005 
Z I NT 1006 
Z I NT TOO 7 


COMMON 

X t 

200) 

* 

Y 

t 200) 

t 

Z ( 200) , TH 

< 200) 

,ZINT1008 

l 

PRESSEt 

200) 

• 

XLL ( 

200,3) 

* 

YLL ( 2 CO , 3 ) , 


Z I NT 1009 

2 

RAP ANG t 

100) 

t 

ZGL 

t 100) 

* 

RHUB ( 100) , RTIP 

t 100) 

U INT 1010 

3 

THHUB t 

100) 

V 

THTIP 

t 100) 

:» 

PRE SSL ( 100, 1 5 ) ® EOCM 

l 3,3) 

y Z INT 10 1 1 

4 

RHO , OMEGA 

• 

POTS SO 

, YOUNGS 

i , RADGEN , 


ZINT1012 

5 

NGENLI 

, LINEl 

, NPRESt 100) 

» 

NEXT ( 200,3) , NP , 

NT , 

Z I NT 10 13 


6 ELMSM ( 6,6) , AMN IN ( 6,6) , ELBSM(9,9) , 

7 P FLGN (9,1) 

DIMENSION Z INT t 1 ,61 , A t 10 > , H(10) , YltlO) 
l XlL(lO) • XIR(IO) 

DIMENSION YU 3) , XL C 3 ) 

DOUBLE PRECISION YU , HT , XO , ZINT , A , H 
1 XIL , XI.R , XL , YL 


DATA L A v L 8 , L C / i , 2 , 3 
DATA A / -.97390652851717 

1 *.•43 3395394 i 2925 

2 .43339539412925 

3 .97390652851717 

DATA H / .06667134430869 

1 .26926671930100 

2 .26926671930100 

3 .06667134430869 
XL( LB) = XL L ( IE, 2) 

XL(LC) = XLLt It, 3.) 

YL(LC) = Y L L t I E , 3 ) 

YO * 0.5 * YL(LC) 

DCJ 3 I = 1,10 


, -.86506336668899 
, -. 1488743 3898163 
, .67940956829902 

/ 

, . 14945134915058 

, .29552422471475 

, • 21 908636251 598 


ABN I N 1 9 » 9 ) 

XT I 10) , AREA (10) 

YI , XI , AREA , 


-.67940956829902 

.14887433898163 

.86506336668899 

.21908636251598 

.29552422471475 

.14945134915058 


YI C n = YO ♦ AT I ) * YO 

XILU) = XL(LC) * YIU) / YL(LC) 

XIR(I) = XL(LB) - ( XL ( LB ) - XLtLC) ) * YIU) / YL(LC) 

IF t I .NE. 1 ) GO TO 2 

HT = 0.0 

DO 1 J = 1,10 

HT = HT ♦ HtJ) 

ARE At I ) = XLtLB) * { 1.0 - Atl) ) * 0.25 * HT 

ZINTt 1 , 5 ) = Z I N T ( 1 , 5 ) +QABS t YLt LC ) ) * 0.5 * ARE At I ) * Ht I ) 

ZINTt 1 , 3 ) - ZlN T ( 1 , 3 ) +DA 8 S t YL ( LC ) ) * 0.5 *YIM) * AREA(I) * HU) 
nn s i = i.in 

XIR(I) - XILtli ) 


DO 
XO 

AREAt I )= 0.0 
OU 4 J = 

XI ( J) = 
AREAt I ) 


1,10 
X I L t I ) 


+ 0.5 * t 


1 , 10 

XO ♦ At J) * l XO - XIL(I) ) 

AREAt 1 ) + XLtLB) * t 1.0 - A(I) ) * 0.25 ♦ HtJ) * XI (J) 

Z INT ( l , t ) = ZINTt 1,1) +UA8S.I YLtLC)) * 0.5 * AREA ( I ) * HU) 

RETURN 

END 


ZINT 1014 
ZINT 1015 
, ZINT 1016 
ZINT10I7 
ZINT 1018 
Z I NT 10 19 
Z I NT 1020 
Z I NT 102 1 
ZINT 1022 
ZINT1023 
Z1NT1024 
ZINT 1025 
ZINT 1026 
ZINT1027 
ZI NT 1028 
ZINT 1029 
ZINT 1030 
Z I NT 1031 
ZINT1032 
ZINT 1033 
ZINT 1034 
Z I NT 10 35 
ZINT1036 
ZINT 1037 
ZINT 1038 
Z I NT 10 39 
ZINT1040 
ZINT 1041 
ZINT 1042 
Z I NT 1043 
ZI NT 1044 
ZINT 1045 
ZINT 1046 
ZINT 1047 
ZINT 1048 
Z I NT 10^9 
ZINT 1050 
Z INT 1051 
Z I NT 1 052 
Z I NT 105 3 
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c 

c 


SUBROUTINE BENSTF I L AA , LBB , LCC , I E ) 

CALCULATE THE ELEMENTAL LOCAL BENDING STIFFNESS MATRIX (ELBSM) 


COMMON X ( 200) 

1 PRESSE ( 200) 

2 RAPANGI 100) 

3 THHUB ( 100) 


Y I 200) 
XLL I 200t 3 ) 
ZGL I 100) 
THTIP ( 100) 


RHO t OMEGA , 
NGENLI • LINE1 


4 

5 

6 ELMSM (6,6) 

7 PFLGNI 9 f 1 ) 

DIMENSION ABN I T ( 9,9) , Z 119,9) 

0 1 MENS ION YLI 3) * XL C 3 ) 

DOUBLE PRECISION ZJl , ZJ2 , Z J3 


Z ( 200) , TH 

YLL ( 200,3) , 

RHUB t 100) , RTIP 
PRE SSL I 100,15) , EDCM 


I 200) 


POISSO , YOUNGS , RADGEN , 

, NPRESUOO) , NEXT I 200,3) 


NP 


I 

< 

NT 


100 ) 

3,3) 


AMN IN (6,6) f ELBSM 1 9, 9) , ABNIN(9,9) 


2 I NT ( 9,9) 


l ZINT 

DATA LA,LB,LC / 1 , 2 
XL ( LB ) = XLL ( I E , 2 ) 
XULC) = XLL HE, 3) 
YLILC) = YLL ( IE, 3) 

ABN INI 1, 1 ) 

ABNINI2, 3) 

ABNINI 3,2) 

ABN IN ( 4,1) 

ABNINI A, 3) 

ABNINI A, 4) 

ABN I N ( 4 , 6 ) 

A8NINI5, 1) 

ABNINI 5, 2) 


XL , 
3 / 


Yt 


, ZJ4 , ZJ5 , ZJ6 , ABN IT v Z1 , 


ABNINI 5,3) = 
l 

ABNINI 5,4) * 
ABN IN I 5, 6 ) * 
ABN IN I 5, 7 ) * 
ABNINI 5, 8 ) = 
ABNINI 5,9) = 
ABNINI 6, I ) = 
ABN INI 6, 3 ) = 
ABNINI 6, 4 ) * 
ABNINI 6,6) = 
ABN IN I 7, 2 ) = 
ABN INI 7, 5 ) * 
ABNINI 8,1) * 
ABN INI 8 , 2 ) * 
ABNINI 8, 3 ) = 
L 

ABN I N I 8 , 4 ) = 

L 

ABN IN I 8, 5 ) * 
ABN IN I 8 , 6 ) = 

L 

ARN I N I 8 , 9 ) = 
ABN INI 9, 1 ) = 
l 

ABNINI 9,2) = 
ABN I N I 9, 3 ) = 


) ♦ XLILC) / XL I LB ) / YLILC) 


YLILC) 
XL I LB) 


)**2 


l 


1.0 

-1.0 

1.0 

-3.0 / XL I LB ) / XL I LB ) 

2.0 / XL I LB ) 

- ABN IN (4,1) 

1.0 / XL I LB ) 

3.0 * I XLILC)**2 - XL I LB ) **2 ) / I XL ( LB) ♦YL ( LC ) )**2 
-2.0 / YLILC) 

2.0 * I XL I LB) - XLILC) 

/ YLILC) 

-3.0 • I XLILC) / XL I LB ) 

- I XLILC) / YLILC) )**2 

3.0 / YLILC) / YLILC) 

- 1.0 / YLILC) 

XLILC) / YLILC) / YLILC) 

2.0 / XL ( LB 1**3 

- 1.0 / XL I LB ) / XL I LB ) 

- ABNINI 6, l) 

ABN IN I 6, 3) 

ABN IN ( 6, 3) 

- ABN l N I 6 , 3 ) 

6.0 * XLILC) 

2.0 ♦ XLILC) 

I XL I LB ) - 3. 0*XL I LC) 

I XL I LB ) * YLILC) )**2 

6.0 * XLILC) * I XLILC) - XL I LB ) 

YL I LC )**2 

-2.0 * XLILC) / XL ( LB ) / XL I LB ) / YLILC) 

XLILC) * I 3 *0*XL I LC ) - 2.0*XLILB) ) / I 
YLILC) ) + *2 
-1.0 / YLILC) / YLILC) 

2.0 * I 2 • 0* XL I LC )**3 - XL(LB)*( 3. 0*XL I LC ) **2 - 
XL ( LB ) **2 ) ) / I XL I LB ) * YLILC) '1**3 
( XL! LB )**2 - XLILC )**2 ) / ( XL I LB ) * YLILC) ) **2 


XL I LB )**3 / YL ILC )**2 * C XL C LB I-XL ( LC ) 
XL I LB ) / XL I LB ) / YL I LC ) 

) * I XL I LB ) - XLILC) ) / 

) t XL I LB ) **3 / 


XL (LB) * 


-2.0 * XLILC) * I XL ( LB ) - XLILC) > **2 / XL(LB)**2 / 
l YLILC )**3 

ABN I N I 9, 4 ) = 2.0 * XL(LC)**2 * 

L I XL I LB ) * YLILC) 


I 3 .0* XL ( LB ) - 2. 0*XL I LC) 
)**3 


) / 


8ENS0010 
8ENS0020 
BENS0030 
, BENS0040 
BENS0050 
, BENS0060 
,BENS0070 
BENS0080 
BENS0090 
BENS0100 
BENSOHO 
BENS 0 120 
BENS0130 
BENS0140 
BENS0150 
BENS0160 
BENSOl 70 
BENSOl 80 
BENS0190 
BENS0200 
BENS0210 
BENS0220 
BENS0230 
BENS0240 
BENS0250 
BENS02 60 
BE NS 02 70 
BENS 0280 
BENS0290 
BE NS 03 00 
BENS03 10 
BENS0320 
BENS0330 
BENS0340 
BENS 03 50 
BENS 0360 
BENS0370 
BEN SO 3 80 
BENS0390 
BENS 0400 
BENS0410 
) BENS0420 
BE NS 0430 
BENS 0440 
BENS0450 
BENS0460 
BENS0470 
BENS 0480 
BENS0490 
BENS0500 
BENS05 10 
BENS0520 
BENS0530 
BENS0540 
BENS 0550 
BENS 0560 
BE NS 05 70 
8ENS0580 
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ABN IN ( 9, 5) * ( XL(LC) / XL(LB) / YULC) )**2 

ABN IN I 9 , 6 ) = 2.0 * XLILC >**2 * I XL I LB ) - XLILC) ) / XL(LB>**2 / 
i YL(LC)**3 

ABN IN I 9 f 7 ) = -2.0 / YL(LC)**3 
ABN IN ( 9» 8 ) = 1.0 / YL(LC)**2 
00 5 l * 1*9 
00 5 J * 1,9 
Z I NT ( 1 9 J ) = 0.0 
6 A 8 N IT ( I, J) = ABNINU, I ) 

CALL Z I NT 2 I LAA , LBB ,LCC , ZJl , ZJ 2 # Z J3 , Z J4, Z J5,Z J 6 .IE ) 

Z t NT I 4 , 4 ) = 4.0 * ZJl 
Z l NT I 4 , 5 ) = P0 I S SO * Z I N T (4,4) 

Z INT (4,6) = 12.0 * ZJ2 
Z INTI 4, 7 ) = 4.0 * Z J 3 
Z I NT 1 4 , 8 ) = 4.0 ♦ POISSO * ZJ 2 
Z I NT (4 ,9 ) = POISSO ♦ ZINTI4, 7) * 3.0 
Z INT (5,53 = ZINT(4,4) 

.ZINK 5.6) = POISSO * ZI NT (4,6) 

Z INT I 5 , 7 ) = POISSO ♦ Z INT I 4, 7) 

Z 1 NT ( 5,8 ) = Z I NT I 4,8) / POI SSO 

Z INT ( 5, 9 > = Z INTI 4,9} / POISSO 

Z INTI 6 , 6 ) = 36.0 * ZJ4 

Z1NT46.7) = 12.0 ♦ ZJ5 

Z I NT ( 6 , 8 ) = 12.0 * POISSO * ZJ4 

Z INT (6,9) = Z INT I 6 , 7 ) * POI SSO * 3.0 

Z INTI 7, 7) = 4.0 * ZJ 6 + 8.0 * I 1.0 - POI SSO ) * ZJ4 

Z I NT 1 7 , 8 ) = 4.0 * I 2.0 - POISSO > * ZJ5 

Z I NT I / ,9 ) =12.0 * PUISSO * ZJ 6 

Z IN T 1 8 , 8 ) = 8.0 * I 1.0 - POI SSO ) * Z J 6 + 4.0 * ZJ4 
Z INTI 8 , 9 ) =12.0 * ZJ5 
Z I NT (9,9 ) =36.0 ♦ ZJ 6 
CO 10 I =4,8 
11 = 1+1 
DO 10 J = 11,9 

10 Z I N T I J , I ) = ZINTM.J) 

ZJl = YOUNGS / I 12.0 * I 1.0 - P0I$S0**2 I ) 

CO 15 1 = 4,9 
DO 15 J = 4,9 

lb ZINTII.J) = Z I NT I I , J ) * ZJl 
DO 20 I = 1,9 
00 20 J = 1,9 
ZU I , J ) = 0.0 
DO 20 K = 1,9 

20 Z 1 1 I , J ) = Z1II,J) + ABN I T I I ,K ) * ZINKK.J) 

DO 25 I = 1,9 
DO 25 J = 1,9 
CL B SMI 1 , J ) = 0.0 
CO 25 K = 1,9 

25 EL H SMI I , J ) = ELBSMI I , J) + Zl(I.K') * ABN IN I K , J ) 

RETURN 

END 


BENS0590 
BENS0600 
BENS0610 
BENS0620 
BE NS 06 30 
BE NS 0640 
BENS0650 
BENS0660 
BE NS 06 70 
BENS0680 
BENS0690 
BENS0700 
BENS07L0 
BE NS 07 20 
BENS0730 
BENS0740 
BENS0750 
BEN SO 7 60 
BEN SO 7 70 
BE NS 07 80 
BENS 0790 
BENS0800 
BEN SO 8 10 
BE N S 0 8 20 
BENS0830 
BENS0840 
BE NS 08 50 
8ENS0860 
BENS0870 
BENS0880 
BENS0890 
BENS0900 
BE NS 09 10 
BE NS 09 20 
BENS0930 
BE NS 0940 
BENS 0950 
BENS0960 
BENS0970 
BENS0980 
BENS0990 
BENS 1000 
BENS1010 
BENS 1020 
BENS 10 30 
BENS 1040 
BENS 1050 
BENS 1060 
BENS 1070 
BENS 1080 
BENS 1090 




nnooooononnoo 


SUBROUTINE Z INT2 ( LAA,LBB,LCCtZJ 1 ,ZJ2,Z43,ZJ4 f Z J5, 
USING GAUSSIAN QUADRATURE, INTEGRATE THE FOLLOWING 
THE SURFACE OF THE TRIANGLE 
F(XL,YL) 

F ( XL , YL ) 

F { XL » YL ) 

FtXUYL) 

F ( XL i YL ) 

F ( XL , YL ) 


ZJ6.IE ) 
FUNCTIONS OVER 


TERM 

TERM 

TERM 

TERM 

TERM 

TERM 


XL 

YL 

XL 

XL 

YL 


*♦ 2 
* YL 
*■* 2 


WHERE 


TERM = ( t XL I LB ) * YL ( LC I 


+ t XL t LC ) - XL C L 8 I ) *YL - YL(LC)*XL)* 
TH { L AA ) + ( YL ( LC ) *XL XL (LC ) *Y» ) *TH ( LBB ) ♦ XL ( LB) * 
THlLCC )*XLJ/XL(LB)/YL(LC> 


Z I NT 20 10 
Z I NT 2020 
ZINT2030 
Z I NT 2040 
Z I NT 2050 
Z I NT 2060 
Z I NT 2070 
ZINT2080 
Z I NT 2090 
Z I NT 2 1 00 
ZINT2110 
ZINT2120 
Z I NT 2 130 
ZINT2140 


COMMON 


X ( 200) 

1 

Y 

( 200) 

t 

Z ( 2 CO ) , 

IH 

( 200) 

, Z I NT2 l 50 

PRESSE ( 200) 


XLL ( 

200, 3) 

9 

YLL ( 200,3) , 



ZINT2160 

RAPANGI 100) 

, 

ZGL 

( 100) 

9 

RHUB ( 100) , 

RTIP 

( 100) 

, Z I NT 2 1 70 

THHUB ( 100) 

9 

THTIP 

( 100) 

9 

PRESSL ( TOO , 15) 

, EDCM 

( 3,3) 

,ZINT2180 

RHO , OMEGA 

9 

P.0 1 sso 

, YUUNGS 

i , RADGEN , 



ZINT2190 

NGENLI , LINE1 

, NPRE S ( 100) 

9 

NEXT ( 200,3) 

♦ NP , 

NT , 

Z I NT 2200 


ELMSM (6,6) 
P FLGN (9,1) 


DIMENSION A (TO ) 

X IR( 10) 

CIMENSIUN YL ( 3) , XL ( 3 ) 

OOUBLF PRECISION ZJ1 , ZJ2 

1 TERM , A 

2 YL 

DATA LA, LB , LC / 1,2 , 3 
DATA A / -.97390652851717 

1 -.43339539412925 

2 .43339539412925 

3 .97390652851717 

DATA H / .06667134430869 

1 .26926671930100 

2 .26926671930100 

3 .06667134430869 
XLL ( IE, 2) 

XLL ( IE, 3) 

YLL ( IE, 3) 


, AMN I N ( 6, 6 ) , E LB SM ( 9 , 9 ) , ABNIN(9,9) , 

H ( 1 0 > , YI(IO) , XI I 1-0) , AREA ( 10,6 ) , XIL(IO) 


ZJ3 , Z J 4 , ZJ5 , ZJ6 , YO , XO , 

H , XI , YI , AREA , XI L , XIR , XL 


» 86506336668899 , 
.14887433898163 , 
.67940956829902 , 

.14945134915058 , 
.29552422471475 , 
.21908636251598 , 


-.67940956829902 , 
.14887433898163 , 
.86506336668899 , 

.21908636251598 , 
.29552422471475 , 
.14945134915058 , 


XU LB) 

XL(LC) 

YL(LC) 

ZJ1 = 0.0 
ZJ2 = 0.0 
ZJ3 = 0.0 
ZJ4 = 0.0 
ZJ5 = 0.0 
ZJ6 = C.O 

YO = 0.5 * YL ( LC) 

00 4 I = 1 , 10 

YI ( I ) = YU ♦ A( I) * YO 

X I L C I ) = XL(LC) * Y I ( I ) / YL (.LC.) 

XIR(I) = XL (LB) - ( XL (LB) - XL(LC) ) * YI(IJ / YL ( LC ) 


Z I NT 22 10 
Z I NT 2220 
, ZINT2230 
Z I NT 2240 
Z I NT 2250 
ZINT2260 
ZINT2270 
ZINT2280 
Z I NT 2290 
Z INT 2300 
Z1NT2310 
ZINT2320 
Z I NT 2330 
Z INT 2340 
ZINT2350 
ZINT2360 
Z INT2370 
Z INT 2380 
ZINT2390 
Z I NT 2400 
Z I NT 24 10 
Z I NT 2420 
ZINT2430 
Z I NT 2440 
Z I NT 2450 
Z I NT 2460 
ZINT2470 
Z I NT 2480 
Z l NT 2490 
Z I NT 2500 
ZINT2510 



XO = X IL ( I ) + 0,5 * 1 

[ XIR(I) - X IL II ) ) 

ZINT2520 


eu 2 j = 1,10 


Z I NT 25 30 


DO L K 1,6 


Z I N T 2 540 

1 

ARF A ( J , K ) = 0.0 


ZINT2550 

2 

X I ( J ) = XO + A{ J ) # 1 

[ XO - X I L ( I ) ) 

Z I NT 2560 


Cu 3 J - 1,10 


Z INT2570 


TERM = ( ( XL (LB ) * YL ( LC ) + ( XL ( LC ) - XL ( LB ) 

) * YI Cl ) - YL ( LC ) * Z I NT 2580 
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U) ftJ ►** 


3 


A 


XHJ) ) * TH(LAA)- ( XL ( LC ) *YI ( I ) - YL(LC)*Xl(J) ) *TH ( LBB ) ZI NT2590 

♦ XL I LB ) *TH(LCC ) *Y I( 1 I )** 3 * XL(LB)*( 1.0 - AM) ) * 0.25 ZINT2600 

* H(J> / XL (L B ) **3 / YL (LC ) **3 ZINT2610 


AREA! 1,1) = AREA (1,1) ♦ TERM 

ARE At 1,2) = AREA ( 1,2) + TERM * XI(J) 

AREAt 1,3) = AREA ( 1,3) 4 TERM * YHU 

AREA! I , A ) * AREA ( I , A ) 4 TERM * XIU)**2 

ARE A( 1,5) = AREA(I,5) + TERM * XMJ) ♦ YIU) 

ARE A( 1,6 ) = AREA ( 1 ,6 ) 4 TERM * YIU )**2 

ZJ1 * ZJ 4 0.5 * ..Hill • AREA(I,1)*0ABS(YL(LC)1 

ZJ2 = ZJ2 4 0.5 * HU) * AREA ( I ,2 ) *0ABS ( YL ( LC ) ) 

Z J3 * ZJ3 + 0.5 * HII) * AREA (1,3) *0AB$ t YL ( LC ) ) 

Z*JA = Z J A 4 0.5 * H(I) * AREA U * A) *0AB S( YL (LC ) ) 

Z J5 = ZJ5 4 0.5 * HU ) * AREA (I ,51 *DAB$< YL ( LC) ) 

Z J6 - l J6 4 0.5 ♦ HIM * AREA ( 1,6) *OABS ( YL ( LC) I 

RETURN 
END 


ZINT2620 
ZINT2630 
ZINT26A0 
Z I NT 2650 
ZINT2660 
ZINT2670 
Z I NT 2680 
Z I NT 2690 
ZINT2700 
ZINT2710 
Z INT2720 
Z I NT 27 30 
ZINT27A0 
ZINT2750 
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10 


15 


SUBROUTINE NPFURC ( 1 ) 

CALCULATE THE LOCAL GENERALIZED NODAL PRESSURE FORCE (PFLGN) FOR 
A TRIANGULAR ELEMENT . 

COMMON X ( 200) , Y < 200) , Z ( 200) , TH ( 200) 

1 P-R.ESS.Ef 200) , XLL ( 200,3) , YLL ( 2C0,3) , 

2 RAPANGt 100) , ZGL < 100) , RHUB ( 100) , RT1P I 100) 

3 THHUB ( 100) , THTIP ( 1001 , PRESSLl 100, 15 > , EDCM T 3,3) 

A RHQ , OMEGA , POISSQ , YOUNGS , RADGEN , 

5 -NG.EN.L1 , LINE1 , NPRESI 100) , NEXT ( 200,3) , NP , NT , 

6 ELMSM (6,6) , AMN I N ( 6 , 6 ) , ELB$M(9,9) , ABNIN<9,9| , 

7 PFLGNT 9,1) 

DIMENSION A BN IT (9, 9) , ZINT<9,1) 

DOUBLE PRECISION ABNIT , ZINT 

CO 10 J = 1,9 

ZINT I J , 1 ) * 0*0 

DO 10 K * 1,9 

ABNI T U, K) = ABN IN ( K , J ) 

CALL Z INT3 ( I, ZINT > 

DU 15 J = 1,9 
PFLGNt J , 1 ) = 0.0 
DO 15 K * 1,9 

PFL GN I J, 1 ) = PFLGNt J,.ll + PRESSEU) * ABNITTJ,K) * ZINT<K,i) 

RETURN 

END 


NPF0R010 
NPFOR020 
NPF0R030 
NPFOR040 
, NPF0R050 
NPF0R060 
, NPFORO 70 
, NPF0R080 
NPF0R090 
NPFORIOO 
NP FOR 120 
NPFUR130 
NPFORI VO 
NPF0R150 
NPF0R160 
NPFORI 70 
NPFORI 80 
NPFORI 90 
NPF0R200 
NPFOR210 
NPF0R220 
NPF0R230 
NPF0R240 
NPF0R250 
NPF0R260 
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SUBROUTINE Z 1 NT 3 t IE,ZINT ) Z I NT 30 10 

USING GAUSSIAN QUADRATURE* INTEGRATE THE FOLLOWING FUNCTIONS OVER ZINT3020 
THE SURFACE OF THE TRIANGLE ZINT3030 

F‘(.XL«YL) * 1.0 ZINT3040 

FI XL f YU * XL Z I NT 3050 

F ( XL * YL ) = YL Z I NT 3060 

f(XL,YL) = XL** 2 Z I NT 3070 

F ( XL » YL I = YL**2 ZINT 3080 

F(XLfYL) = XL** 3 Z I NT 3090 




FI XL* YL 1 * 

X L * * 2 

* 

YL 




Z1NT3100 



F 1 XL , YL ) = 

YL **2 

* 

XL 




ZINT 3 110 



F I XL * YL ) = 

YL**3 






Z I NT 3 1 20 










Z I NT 31 30 

COMMON 

X 1 

200) * Y 

( 200) 

» 

Z 

I 200) , TH 

( 

200) 

, Z I N T 3 1 4 0 

1 

PRESSEI 

200) , XLL ( 

200, 3) 

, 

YLL I 

200*3) , 



Z I NT 3 150 

2 

RAPANGI 

100) , ZGL 

1 100) 

• 

RHUB 

( 100) , RTIP 

i 

100) 

* Z I NT 3160 

3 

THHU8 I 

100) , THIIP 

1 LOO) 

* 

PRESSLI 100, 15) ,EOCM 

l 

3,3) 

, Z I NT 31 70 

4 

RHO * OMEGA , POISSO 

, YOUNGS , RADGEN , 



ZI NT3180 

5 

NGENL I 

, LINE! * NPRESI 100) 

, 

NEXT 

I 200,3) , NP , 

NT 

, 

Z I NT 3 1 90 


6 E LMSM I 6 > 6 ) * 

7 PFLGN I 9*1) 
DIMENSION Z INT ( 9 * 1 ) 

1 * X IL ( 10 I , 

DOUBLE PRECISION YI 


AMN l N ( 6 , 6 I , E LB S M (9*9) , ABN I N (9* 9) 


, A ( 1 0 ) , 
XIRUO) , 
XI, AREA 


OATA 

DATA 


LA* LB , LC / 


TERM 

l , 2 


ZINT 
3 / 


HI 10 ) , 
XL ( 3 ) i 
, XIL , 

* A * H 


YI ( 10) , 

YL I 3 ) 

XIR , XL 


XI ( 101 


, ZINT 3200 

Z I NT 32 10 
AREA! 1 0* 9 ) Z I NT 3220 
Z I NT 3230 


YL 


XG 


YO 


A t -.97390652851717 

1 -.43339539412925 

2 .43339539412925 

3 .97390652851717 

OATA H / .06667134430869 

1 .26926671930100 

2 .26926671930100 

3 .06667134430869 
XL I LB ) = X L L ( IE, 2 ) 

XLILC) = XLL l IE* 3) 

YL(LC) = YLLl IE, 3) 

YO = 0.8 * YLILC) 

DO 5 I = 1,10 

YI( I) = YO ♦ At I ) * YO 


*.86506336668899 

-.14887433898163 

.67940956829902 

. 14 94 5L34915058 
.29552422471475 
.21908636251598 


-.67940956829902 

.14687433898163 

.86506336668899 

.21908636251598 

.29552422471475 

.14945134915058 


XIL I I ) = 

XLIICI * YI ( 1 

l ) 

/ YLILC) 


XIRII) = 

XL ( L B ) - ( XL(LB) - 

XL | LC ) ) * 

YIII) / 

XO = X IL ( I ) + 0.5 * ( 

X IR I I ) 

- 

XIL (I ) ) 


DO 2 J = 

1,10 






DO IK = 

1,9 






AREA! J,K ) 

= 0.0 






X I I J ) - XG ♦ A I J ) * I 

XU 

1 - X I L ( I ) ) 


CO 3 J = 

1, 10 






TERM = XLtLB) * ( 1.0 

~ 

All) 

) 

* 0.25 * 

H 1 J ) 

AREA! 1,1) 

= AREAt 1,1) 


TERM 




AREA! I ,2 ) 

= AREAt 1,2) 

♦ 

TERM 

* 

XIIJ.) 


AREA! 1,3) 

= AREAt 1,3) 

4- 

TERM 

* 

YI II.) 


AREA! 1,4) 

^ AREAt 1,4) 

4- 

TERM 

* 

XI t J ) * * 2 


AREA! 1,5) 

= AREAt 1,5) 

4- 

TERM 

* 

Y I 1 1 ) ** 2 


ARE At 1*6 ) 

= ARE AM ,6) 

+ 

TERM 

* 

XI I J ) * * 3 


ARE At 1,7) 

= AREAt 1,7) 

4- 

TERM 

* 

XI ( J)**2 

* YI (I ) 

ARE At 1,8) 

= AREAt 1,8) 

+• 

TERM 

* 

XI IJ) * 

nu ) * * 2 

AREAt l ,9) 

= AREAt 1,9) 

4- 

TERM 

* 

■YIM ) ** 3 



YLILC) 


Z I NT 3240 
ZINT 3250 
ZINT3260 
ZINT3270 
ZINT 3280 
ZINT 3290 
ZINT3300 
Z I NT 33 10 
Z I NT 3320 
ZINT 3330 
Z I NT 3340 
Z I NT 33 50 
ZINT 3360 
ZINT3370 
Z I NT 33 80 
ZINT3390 
ZINT 3400 
Z l NT 3410 
ZI NT 3420 
Z I NT 3430 
ZINT 3440 
ZINT 3450 
ZINT3460 
ZINT 3470 
Z INT 3480 
ZINT 3490 
ZINT 3500 
Z I NT 35 10 
ZINT 3520 
ZINT 3530 
ZINT3540 
ZINT 3 550 
ZINT 3560 
ZINT3570 
ZI NT 35 80 
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TERM = l) A 8 S ( VULCI ) * 0.5 * H<II ZINT3590 

DO A J = 1,9 Z I NT 3600 

A ZlNT(J.l) = ZINTfJ.l) + TERM * AREAIl.J) ZINT3610 

5 CONTINUE Z I NT 3620 

RETURN Z I NT 36 30 

END ZINT36A0 
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c 

c 

c 


8 


9 


10 


1 

2 


SUBROUTINE NCFURC < LAA , L68 , LCC , IE , NCF I 

CALCULATE THC COMMON GENERALIZED CENTRIFUGAL FORCE MATRIX ICFLGN 
FOR A TRIANGULAR ELEMENT . 


COM MU N 


X ( 

PRESSU 
RAPANGt 
TFHUB ( 


200 ) 

200 ) 

100 ) 

100 ) 


Y 

XLL i 

ZGL 

THTIP 


( 200) , l ( 200) , TH ( 200) 

200,3) , YLL ( 200,3) , 

( 100) , RHUB ( 100) , RTIP ( 100) 

{ 100) , PRE SSL (100,15) ,EDCM { 3,3) 


RHO , UMEGA , 
NGENLI , LINE1 
ELMSM(6,6) 
PFLGNt 9, 1) 


NT 


POISSO , YOUNGS , RAOGEN , 

, NPRESUOO) , NEXT f 200,3) , NP 
AMN INC 6,6) , ELB SM ( 9 , 9 ) , ABNIN(9,9) , 
CFLGNC18, 1) , EL ST IF ( 1 8 , i 8 ) , ECST I F ( 18 , 18 > 


PFCCNU8.il) « 
FORCE ( 200 , 6 ) 
DIMENSION AC 10) , HI 10) 


CFCGN ( 18,1) , MEXt 200,8) , IMEX(200), 


Y I C 1C) , XI (10) 

X IRC 10) , TERM! 9 ) , XL (3) , YL(3) 
DOUBLE PRECISION AREE , TERN , YO , XO , TERMO 
TERM3 , T ERMA , TERM5 , A , H 


AREA (10,15) , X I L ( 10 


AREA , X I L 
DATA A / -*97390652851 717 , 
“*43339539412925 , 
.43339539412925 , 
.97390652851717 / 

DATA H / .06667134430869 , 

.26926671930100 , 
.26926671930100 , 
.06667134430869 > 


XIR , TERM , XL 
■ • 86506336668 899 , 
•.14887433898163 , 
.67940956829902 , 

.14945134915058 , 
.29552422471475 , 
.21908636251598 , 


r TERM 1 , TERM2 , 
r Y I , XI , 

YL 

-.67940956829902 

.14887433898163 

.86506336668899 

.21908636251598 
.29552422471475 
. 14945134915058 


DATA 
IF ( 
DO 


LA,LB,LC / 
NCE .GT. 0 
J = 1,18 


t 2 , 

GO TO 


CELGNt J, 1) 
AREE = 0.5 
TERN = RHO 
CFLGN( 1,1) - 
CELGNt 2 , 1) = 
CFLGNf 7, 1 ) = 
CELGNt 8,1) = 
CELGNt 13,1 ) = 


0.0 

ABS ( XL L ( IE. 2) * YLL(IE,3) 
UMEGA**2 * AREE / 3.0 
X ( L A A ) * TH(LAA)* TERN 
Y(LAA)* TH(LAA)* TERN 
X ( LBB ) * THC LBB )* TERN 
YTLBB)* TH( LH6 ) * TERN 
X ( L C C ) THtLCCi* TERN 


CEL GN ( 14, 1 ) = YtLCCi* TH(LCC)* TERN 
RETURN 

XL (LB) = XLL ( IE, 2) 

XL(LC) = XLL I IE, 3 I 
YL (LC) = Y L L ( I E » 3 ) 

CO 10 I = 1,18 
CELGNt 1,1) = 0.0 
YU = 0.50 * YLCLC) 

DO 6 I = 1,10 
Y I ( I ) = YU + ATI) * YU 

X I L I I ) = XL t LC ) * YIU) / YLCLC) 

XIR (I) = XL (LB) - (XL (LB) - XL(LC) 

XO - XILCI) + 0.5 * ( X IRC 1 ) - XILCI) ) 

CO 2 J = 1,10 

DO l K = 1,15 
ARE A( J , K ) = 0.0 

XI { J) = XO + A C J ) * (XU “ XILCI)) 

no 4 j a i,io 

TERMO - XL (LB ) * ( i . 0 - A ( I ) ) *0. 25*H ( J ) * ( ( XL ( LB) *YLC LC) + CXLCLC) 


* YI(I ) / YL(LC) 


1 


XL ( LB ) ) *Y I ( M ~ YL (LC ) *X|( J ) >*TH(LAA) 


(XL(LC)*YlCn “ 


NCF00010 
) NCE00020 
NCF00030 
NCF00040 
, NCE00050 
NCE00060 
,NCF00070 
, NCF00080 
NCF00090 
NCF00100 
NCE001 10 
, NCF00120 
NCF00130 
NCF001 40 
) ,NCF00 150 
. NCF00160 
NCF00170 
NCF00180 
NCF00190 
, NCF00200 
, NCF00210 
, NCF00220 
NCF00230 
, NCF00240 
, NCF00250 
, NCE002 60 
NCE00270 
NCF00280 
NCF00290 
NCF00300 
NCF00310 
NCF00320 
NCFQ0330 
NCF00340 
NCF00350 
NCF00360 
NCF00370 
NCE003 80 
NCF00390 
NCF00400 
NCE00410 
NCE00420 
NCF00430 
NCF00440 
NCF00450 
NCF00460 
NCF00470 
NCF00480 
NCF00490 
NCF00500 
NCF00510 
NCF00520 
NCF00530 
NCF00540 
NCF00550 
NCFU0560 
“ NCF00570 
NCF00580 
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2 YULC‘)*XIU> >*TH(t8B.) ♦ XL ( IB ) *TH ( LCC ) ♦ Y I (I ) ) NCF00590 

3 / XL (LB) / YL(LC) NCF00595 

TFRMl = ( EOCM ( 1 , 1 ) ♦( EDCM (1*1)) ♦ FOCM ( 2 , 1 ) **2 ) NCF00600 

1 ♦X I C J J ♦ t EDCM ( 1*1) ♦ EDCM (1,2) ♦ E'DCM(.2 V 1 )*.( EDCH ( 2 , 2 ) ) ) * Y Id ) NCF00610 

2 + X { L A A ) * EDCMUtl) + Y(LAA) * EDCM(2,l> NCF00620 

TERM2 = ( EDCM ( l , 2 ) ♦ ( EDCM<1,1)> + EDCM ( 2 , 2 ) ♦EDCM ( 2 , i ) ) *X I ( J ) NCF00630 

1 + (€DCM(1 V 2)**2 ♦ EDCM 1 2 *2 ) *1 EDCM ( 2 , 2 )) ) *Y I ( I) NCF006A0 

2 ♦ X { L A A ) ♦ EDCM (1,2) ♦ Y { L A A ) ♦ EOCM (2, 2) NCF00650 

T ERM3* (EDCM I 1 , 3 ) ♦ (EDCM ( 1 , 1 ) ) +EDCM ( 2 ,3 ) ♦EOCM ( 2 , NCF00660 

il))«XKJ )■■♦.< EDCM ( 1,3) ♦EDCM (1,2) ♦ EDCM (2, 3)*( EDCM (2,2) ) ) *Y ill INCF00670 

2 + X ( LA A ) ♦ E DCM ( i , 3 ) ♦ Y(LAA) ♦ EDCM (2, 3) NCF00680 

1.0 - X I ( J ) / XL ( LB ) ♦ (XL(LC) - XL CLD ) ) /XL (LB ) /Yl UC ) ♦Yl 1 1 ) NCF00690 


TERMA * 
TERMS = 
TERM( l ) 


1 

2 

1 

2 

1 

2 

1 

2 

1 

1 

2 


X I ( J ) / X L I L 8 ) - XL ( LC )♦ Y I ( l ) /XL ( LB ) / YL ( LC ) 

.= ABN IN ( 1, 1 ) ♦ XI ( J)»*2*ABNINO«l) ♦ YI( t ) ♦♦2*A0NTN (5, i ) 

♦ X I ( J ) ♦♦3*ABN IN ( 6 , l ) ♦ XI I I ( I ) ♦♦2* ABN I N( 8, i ) ♦ 

Y I ( I ) ♦ + 3 ♦ABN IN ( 9 , I ) 

TERM(2> - Y I ( I ) ♦ABN IN I 3,2) «* Yl 1 1 ) ♦♦2*ABNIN(5,2) ♦ X l ( J ) ♦♦2* Y I (I) 

♦ ABN I N ( 7,2) ♦ XIU)*YI m**2*ABNJN(8»2J ♦ Y I 1 1 1 * ♦ 3 * 

ABNINt 9,2) 

TERM(3) = XI ( J ) ♦ABN I N ( 2,3) ♦ X I ( J ) ♦♦2* ABN IN I A, 3) ♦ YI(I)M2* 

ABN IN ( 5, 3 ) + XKJ ) ♦♦ 3* A BN IN ( 6 , 3 ) ♦ XU J) ♦Yl I I) ♦♦2+ 

ABN I N ( B , 3 ) ♦ Yl ( I ) ♦♦ 3* ABN I N ( 9 , 3 ) 

XI (J) ♦^♦ABNINt A,A J ♦ Yl ( I ) ♦♦2*ABNIN ( 5 , A ) + XI CJ ) **3 
ABN I N ( 6, A ) + XUJ)*YUI)**2 * A8NI N( 8, A ) ♦ Yl ( II ♦♦3 « 

ABN INI 9, A ) 

X I ( J ) ♦♦ 2 ♦ Y I ( I ) ♦ A B N I N ( 7 , 5 ) ♦ XI I J) ♦ Y 1 1 I ) *♦£ ♦ ABNIN ( 8, 3 )NCF008 30 

♦ Y I ( I ) **3 ♦ ABNIN (9 ,5 ) NCFO08AO 

TERM! 6 ) = X I ( J ) **2 ♦ ABN INI A, 6 ) ♦ Y1U)**2 ♦ ABNIN(5,6) ♦ XI ( J ) ♦♦3NCF00850 


TERMl A) 


TERM( 5) 


NCF00700 
NCF00710 
NCF00720 
NCF00730 
NCFO07A0 
NCF00750 
NCF00760 
NCF00770 
NCF00780 
NCF00790 
NCF00800 
NCF008 l 0 
NCF00820 


♦ABNINt 6,6) 

ABN IN I 9, 6) 

Y I 1 1 ) ♦ ♦ 2 ♦ ABN I N ( 5 , 7 ) 
Y I ( I > * ♦ 2 ♦ ABN IN ( 5 , 8 ) 
Y I ( I ) ♦♦2 ♦ ABN l N ( 5,9) 
= AREA ( 1,1) ♦ TERMO ♦ 
= AREAt 1,2) 

= ARE A ( I , 3) 

= AREA! I , A ) 

= AREA (1,3) 

= A RE A (1,6) 


+ X I ( J ) ♦ Y I ( I ) ♦ ♦ 2 ♦ABNI N ( 8, 6) ♦ Y I ( I ) ♦ ♦ 3 ♦ 


TERMO 

TERMO 

TERMO 

TERMO 

TFRMO 


TERM! 7) = 

TERM(8) = 

TERMO) * 

AREAl 1,1) 

ARE A( 1,2 ) 

ARE A( 1,3) 

AREAt I, A) 

AREAt 1,5 ) 

ARE A ( 1 , 6 ) 

DO 3 K = 1,9 

ARE A ( I , K +6 ) = AREAt I , K + 6 ) 
CONTINUE 

TERMO = 0.5 ♦ HCI) 

DO 5 J = 1,15 

CFLGNt J, I ) = CFLGNt J, 1) + TFRMO 

CONTINUE 

RETURN 

END 


♦ Y I ( l |**3 ♦ ABN I N( 9 , 7 ) 

♦ Y 1 1 I '>•♦♦3 ♦ ABNIN(9,8) 

♦ XM.J)*YI Cl)**2 ♦ ABNI N I 8,9 ) 
TERMA ♦ TERM1 

TERMA ♦ TERM2 

TERMS ♦ TERMl 

TERMS ♦ TERM2 

YL(LC) ♦ Yl ( 1 ) ♦ TERMl 

YL ( LC ) ♦ Y I ( I > ♦ TERM2 


+ TERMO ♦ TERM(K) ♦ TER M3 

♦ RHO ♦ UMFGA*^2 ♦DABS ( YL ( LC ) ) 


♦ AREA 1 1 , J ) 


NCF00860 

NCFG0870 

NCF00880 

NCF00890 

NCF00900 

NCF00910 

NCF00920 

NCF00930 

NCF009A0 

NCF00950 

NCF00960 

NCF00970 

NCF00980 

NCF0Q990 

NCFOIOOO 

NCF01010 

NCF01020 

NCF01030 

NCF010A0 

NCF01050 
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SUBRUUT I NE COMSTF { IE . NCF ) 

C CALCULATE THE STIFFNESS MATRIX (ECSTIF) , nodal pressure force 
C MATRIX (PFCGN), AND NODAL CENTRIFUGAL FORCE MATRIX (CFCGN) OF A 

C TRIANGULAR ELEMENT IN THE COMMON COORDINATE SYSTEM (X,Y,Z) . 

C 

COMMUN X ( 200) , Y ( 200) • Z ( 200) , TH ( 200) 

1 PRESSE ( 200) , XL ( 200,3) , YL ( 200,3) , 

2 kAPANG! 100) , ZGL ( 100) , RHUB ( 100) , RTIP ( 100) 

3 THHUB ( 100) , THTIP ( 100) , PRESSL ( 100, 15 ) , EOCM ! 3,3) 

A RHO , OMEGA , PUIS SO , YOUNGS , RADGEN , 

5 NGENLI , LINE! , NPRES! 100) , NEXT ( 200,3) , NP , NT , 

6 ELMSM 16,6) , AMN IN ( 6 , 6 ) , ELBSM(9,9) , ABNI N (9,9) , 

7 P FLGN t 9, 1 ) , CFLGN ( 18,1) , ELSTIF ( 18 , 18 ) , ECS T I F ( 18 , 18 ) 

8 PFCGN ! 18,1) , CFCGN (18,1) 

DIMENSION R6 ( 18,18) , RESUL T ( 1 8, 1 8 ) , EPFLGN ( 18,1) , I NO (18) 
COUBLE PRECISION RESULT , EPFLGN 

DATA IND / 1,2,7,8,9,16, 3,4,10,11,12,17, 5,6,13,14,15,18 / 

DO 5 I = 1,18 
DO 5 J = 1,18 
5 R6( I, J ) - 0.0 

DO 10 I = 1,3 
DO 10 J - 1,3 
R6 1 I , J ) = EDCM! I, J ) 

R6( l + 3 , J +3 ) = ECCMMtJ) 

R6 ! I +6 , J + 6) = EDCM ( T , J ) 

R6 ( I +9 , J + 9 ) = E DC M I I , J ) 

R6( 1*12, J + 12) = EDCM I I,J) 

10 R 6 1 1+15, J+15) = EDCM ( I, J) 

WRITE ( 4 • I E ) R6,AMNIN,ABNIN 
DO 20 I = 1,18 

00 20 J = 1,18 

RESULT! I, J) = 0.0 
DO 20 K = 1,18 

20 RESULT I t , J ) * -RESULT (I, J) * R6(I,K) * .ELSTIF (K V J ) 

DO 30 I - 1,18 

CO 30 J = 1,18 

ECSTIF! I, J) = 0.0 
DO 30 K = 1,18 

30 ECSTIF! I, J) = ECST I F ( I , J ) + RESUL T ( I ,K) *R6!J,K) 

CO 40 l * l, 18 
40 EPFLGN! I , 1 ) = 0.0 
00 50 I * 1,3 

EPFLGN! 1+2,1) = PFLGNU,1) 

EPFLGN (1+8,1) = PFLGN! 1+3,1) 

50 EPFLGN! 1+14,1) = PFLGN! 1+6,1) 

DO 60 I = 1,18 

PFCGN! 1,1) = 0.0 

IF ! NCF .EO. 0 ) GO TU 53 

CFCGN! 1,1) = CFLGN! IND! I ) ,1) 

GO TU 55 

53 CFCGN! 1,1) = CFLGN! 1,1) 

55 CO 60 J = 1, 18 

60 PFCGN! 1,1) = PFCGN (1,1) + R6!I,J) * EPFLGN! J,l) 

IF ( NCF .EG. 0 ) GU TU 75 
CO 65 I = 1,18 
RFSULT! 1,1) = 0.0 
DO 65 J = 1,18 

65 RFSULT ( T , i ) = RESULT!!,!) + R6!I,J) * CFCGNIJ,!) 


CO MS TO 10 
COMST020 
COMS TO 30 
C0MST040 
COMS TO 50 
,COM$ T060 
CO MS TO 70 
,C0MST080 
, COMS T090 
COMS T1 00 
COMSTliO 
C0MST120 
COMS T 130 
COMS Ti 40 
CO MS T l 50 
COMS T 160 
COMS T 170 
COMS T 180 
COMS T 190 
COMS T 200 
COMST210 
C0MST220 
COMS T2 30 
CO MS T 2 40 
COMS T 2 50 
COMS T2 60 
C0MST270 
C0MST280 
COMST290 
COMS T 300 
COMS T3 10 
COMS T3 20 
COMS T 3 30 
COM ST 340 
COMS T 3 50 
COMST360 
COMS T 3 70 
COMS T 380 
COMS T3 90 
C0MST400 
COMST410 
C0MST420 
C0MST430 
C0MST440 
C0MST450 
COMS T4 60 
C0MST470 
COMS T 4 80 
COMS T 490 
COMST500 
COMS T 5 10 
C0MST520 
COM S T 530 
C0MST540 
C0MST550 
C0MST560 
COMS T5 70 
C0MST580 


CG 70 I = l, 18 

70 CFCGN! 1,1) = RESULT! 1,1 ) 
75 RETURN 
END 


COMS T 5 90 
COMS T 600 
CQMST610 
COMS T 620 
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o o o 


SUBROUTINE ACOF ( I ) 

ADO VALUES OF COMMON NODAL PRESSURE FORCE 


AODFOOiO 

(PFCGN) AND COMMON NGDALADDF0020 


CENTRIFUGAL FORCE (CFCGN) WHICH ARE COMMON TO A COMMON NODE 


AOOFOO 30 
ADDF0040 


COMMON 

X < 

200 ) 

» 

y 

( 200) 

, 

l 

( 200) , TH 

( 200) 

, ADQF0050 

1 

PRESSF ( 

200) 

, 

XL ( 

200,3) 

* 

YL ( 

200,3) , 


AD0F0060 

2 

R AP ANG ( 

100) 

• 

ZGL 

( 100) 

, 

RHUB 

( 100) , RTIP 

( 100) 

, ADDF0070 

3 

THHUB ( 

100) 

f 

THTIP 

( 100) 

9 

PRESSLC 100, 15 ) » EOCM 

( 3,3) 

, ADDF0080 

A 

RHO , OMEGA 

, 

POISSO 

, YOUNGS , RADGEN , 


ADDF0090 

5 

NGENLI 

, LINE! 

, NPRES(iOO) 

t 

NEXT 

( 200,3) , NP , 

NT , 

A0DF0100 


i ELMSM (6,6) » A M N I N ( 6 » 6 ) * ELBSM(9,9) # ABNIN(9,9) , 

7 PFLGN(9,l) , CFLGN (18,11 , ELST IF< l 8, i 8 ) , ECST I F ( 1 8, 1 8 ) 

3 PFCGN (18,1), CFCGN ( 1 8, 1 ) » tfEX(20O,8), IMEXI200), FORCE ( 

9 200,6) 

LA = NEXT! 1,1) 

LB * NEXT C 1 ,2 ) 

LC = NEXT (I , 3 ) 

CO 30 J s 1,6 

FORCE ( LA, J ) = FORCEUA.J) * PFCGN ( J ,1) ♦ CFCGNIJ ,1) 

FORCE (LB , J ) = FORCE (LB, J ) + PFCGNU+6 ,i) ♦ CFCGNU + 6 ,1) 

FORCE ( LC , J ) = FORCE ( LC , J ) + PFCGN! J + 12 , 1 ) ♦ CFCGN ( J + 12 , i ) 

RETURN 

ENO 
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VJl wP* W <VJ 


SUBROUTINE PRINT! 

PRINT GEOMETRIC BREAK-UP AND ASSOCIATED PROPERTIES 


CGMMON X 


X { 

200) 


Y 

( 200) 

, 

Z 

< 2 CO) , TH 

( 200) 

,PR l NT040 

PRESSEI 

200) 

* 

XL ( 

200,3) 

, 

YL ( 

2 00,3) , 


PR I NT 050 

RAPANGt 

100) 

t 

ZGL 

( 100) 

t 

RHUB 

( 100) , RTIP 

{ 100) 

t PR 1 N T O 60 

THHUB { 

100) 


THTIP 

< 100) 

, 

PRESSLI 100, 15) ,£DCM 

( 3,3) 

fPRlNTOTO 

RHO , OMEGA 


POISSO 

, YOUNGS 

, , RADGEN , 


PRINT080 

NGENt l 

, LINE! 

, NPREStlOO) 

* 

NEXT 

l 200,3) , NP , 

NT 

PR I NT 090 


KOUNT = 0 
WRITE (6,5) 


PRINT 100 
PR I N T 1 10 

FORMAT ( 1H1//38X,29HRESULTING TRIANGULAR ELEMENTS ///) PRINT120 

CO 20 I * 1 , NT PR I NT 1 30 

AREA = ABS I XL I I ,2 ) * YL(I,3) ) / 2.0 PRINTUO 

PLOAO = AREA • PRESSE ( I ) PRINT150 

WRITE (6,10) l , AREA , PRESSEI I ) , PLOAD PRINT156 

FORMAT (45X 'ELEMENT NO. • 13 / UK 'AREA s' F10.6.10X 'PRESSURE =PRINT160 

1 • EI2.5.10X 'LOAD * • £12.5 / 20X 'NODE NO. X Y PRINT165 

2 l TH XL YL ' ) PRINT170 

LA = NEXT! 1,1) PRINT180 

LB = NEXTt 1,2) PR I NT 190 

LC = NEXT (1,3) PRINT200 

WRITE (6,15) LA,X(LA),Y(LA),Z(LA),TH(LA), XL (1,1), YL ( I , 1 ) , LB , X ( LB ) , PR I NT2 10 

1 Y( LB ) , 2 ( LB ) , TH( LB ) , XL ( I , 2 ) , YL ( I ,2 ) , LC , X ( LC ) , Yt LC ) , PRINT220 

2 Z(LC), TH(LC),XL ( I ,3) ,YL ( I ,3) PRINT230 

FORMAT ( 1 7 X , 5HL A , I 3 , 5 X , 3F 10. 3 , 3F 1 0. 4/ 1 7X , 5HLB , I 3, 5X , 3F 10. 3, PR INT2A0 

1 3F10.A / I7X.5HLC , 1 3 , 5X , 3F 10 . 3, 3F 1 0 .4/ / ) PRINT250 

KOUNT = KOUNT ♦ I PRINT260 

IF ((KOUNT .EQ. 7) .AND. (I .NE. NT)) WRITE (6,5) PRINT270 

IF ( KCUNT .EQ. 7 ) KOUNT * 0 PRINT280 

CONTINUE PRINT290 

RETURN PRINT300 

END PR I NT 3 10 
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SUBROUTINE DfcFL ( I PRINT ) 

C SOLVE FUR THE NO CAL DEFLECTIONS IDISPLJ 

C SYS TEH . 


IN THE COMMON COORDINATE 


COMMON 


X ( 
PRESS El 
RAPANGt 
THHUB ( 


200 ) 
200 ) 
i 00 J 
100 ) 


{ 


Y 

XL 
ZGL 
THTIP 
PUIS SO 


TH 


t 200) 

200 , 3 ) 

( 100 ) 

( 100) , PRESSU 100, 15) ,EOCM 
YOUNGS , RAOGEN , 


Z 

YL ( 
RHU8 


( 2 CO) 
200,3) 
( 100 ) 


I 200) 


RTIP 


100 ) 

3,3) 


NT 


RHO , OMEGA 

NGENLl , LINE! , NPRESUOO) , NEXT t 200,3) , NP 
FLMSM (6,6) , AMN I N (6,6 ) , ELBSM<9,9) , ABNIN(9,9) , 

PFL GN (9,1) , CFLGN ( 1 8 , l ) , EL ST I F ( 1 8, 1 8 ) , ECST I F ( 1 8 , 1 8 ) , 

PFCGN (18,1), CFCGN ( 1 8 , 1 ) , MEX{200,8), IMEX(200), FORCE ( 

200,6) 

COMMON / MANE / NSUBS , 1 PGS I 200 ) , NBTS < 10, 1 5 ) ,N I TS ( 10, 15 ) , N8N ( 10 ) , 

1 INTN(IO) 

DIMENSION D l S PL A ( 900 ) , COEFFI900) 

1 HEX T ( 8 ) , DISPLt 18,200) 

DATA UISPL / 3600*0.0 / 

IEQ = 6 * I NP - NGENLl ) 

II = IEQ ♦ 1 

IF I IPRINT .GT. I ) WRITE (6,5) 11, IEQ 

FORMAT I IH1//10X, 18 HFQL LOWING ARE THE ,I4,30H COEFFICIENTS FOR E ACDEFL02 30 
1H OF THE , I4,45H SIMULTANEOUS EQUATIUNS FOR NODAL DEFLECTIONS // ) DEFL0240 


EQUA T I 6 , 900 ) , CGEFR(900) 


DEFL0010 
DEFL0020 
DEFL 00 30 
DEFL0040 
,DEFL0050 
DEFL 0060 
, DEFL 00 70 
» DEFL 00 80 
DEFL0090 
DEFL0100 
DEFL0110 
t DEFL0120 
DEFL0130 
0EFL0140 
DEFL0150 
DE FLO 160 
DEFL0170 
DEFL0180 
DEFL 0190 
DEFL0200 
DEFL0210 
DEFL0220 


50 


60 


66 


CO 90 I = l ,NP 


DEFL 0260 

IF ( IPOS( I ) .LT. 0 ) GO 

TO 90 

DEFL0270 

KOUNT = KOUNT ♦ 1 


0EFL0280 

IMEXT * I MEX ( I ) 


DEFL0290 

DO AO J * l, IMEXT 


DEFL0300 

MEX T ( J ) = MEX ( I , J ) 


DEFL03 10 

00 50 J - 1,11 


DEFL0320 

CO 50 K * 1,6 


DEFL0330 

EQUAT (K, J ) = 0.0 


DEFL0340 

00 80 J = 1, IMEXT 


UEFL0350 

K2 = MEXTIJ) 


0EFL0360 

FIND ( l * K2 ) 


DEFL0370 

LA * NEX T ( K 2,1 ) 


DEFL0380 

LB = NEX T ( K 2 , 2 ) 


DEFL0390 

LC = NEX T ( K2 , 3 ) 


DEFL0400 

NA - 6 * IPOS (LA) 


DEFL0410 

NB = 6 * I POS ( L8 ) 


DEFL 0420 

NG - 6 * IPOS(LC) 


DEFL0430 

READ { 1 * K 2 ) ECST IF 


DEFL0440 

DO 75 K = 1,6 


DEFL0450 

IF ( LA .EQ. I ) I NO 1 = K 


DEFL 0460 

IF { LB .EQ. I ) INDI = K 

+ 6 

DEFL 04 70 

IF ( LC .EQ. I ) INDI = K 

♦ 12 

DEFL 04 80 

CO 70 L = 1,6 


DEFL 04 90 

KA = NA ♦ L 


DEFL0500 

KB = NB ♦ L 


DEFL 05 10 

KC = NC ♦ L 


DEFL 05 20 

IF ( IPOSILA) .LT. 0 ) GO 

TO 60 

DEFL0530 

EQUAT (K,KA) = EQUA I ( K , KA ) 

♦ EC ST I F (INDI , L ) 

DEFL 0540 

IF ( IPUS(LB) .LT. 0 ) GO 

TO 65 

DEFL 05 50 

EQUAT I K f KB) = EQUAT ( X , K B ) 

+ ECSTIFI INDl,L+6) 

DEFL 05 60 

IF ( IPOSiLC) .LT. 0 i GO 

TO / 0 

DEFL0570 

EQUAT(K,KC) = EQUAT(K,KC) 

♦ EC S T I F I I ND 1 , L + 1 2 ) 

DEFL 0580 
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70 

CONTINUE 

DEFL0590 

7 5 

CONTINUE 

DEFL06Q0 

80 

CONTINUE 

DEFL06 10 


00 85 K = 1,6 

DEFL0620 


J1 * 6 * ( KOUNT - l 1 ♦ K 

DEFL0630 


EQUAKK, lEG + 1) = FORCE I I , K ) 

0EFL06A0 


IF ( 1 PR IN T .01. 1 ) WRITE (6,86) ( EUUAT ( K , J ) f J= 1,11) 

DEFL0650 

85 

WRITE ( 3 • J 1 ) (EQUATIK, J),J = l,i20i) 

DEFL 0660 

86 

FOR PA T ( lOE.i 2 U ) 

0EFL0670 

90 

CONTINUE 

DEFL0680 


K = i 

DEFL0690 

100 

READ ( 3* K ) COEFF 

DEFL0700 


I = K + 1 

DEF LOT 10 


IF ( ABS ( COEFF! K ) ) .GT. I.OE-IO ) GO TO 12 C 

DEFL0720 


CO 105 J = I, l EQ 

DE FLO 7 30 


READ ( 3 • J ) COEFR 

DE FLO 7 AO 


J1 * J 

DEFL 07 50 


IF ! ABS I COEFR(K) ) .GT. 1.0E-10 ) GO TO 115 

DE FLO 760 

105 

CONTINUE 

DEFL077O 


WRITE (6,110) 

DEFL 0780 

110 

FORMAT ( 32H DISPLACEMENT MATRIX IS SINGULAR ) 

DEFL0790 


HP = -NP 

DEFL0800 


RETURN 

DEFL08 10 

115 

WRITE ( 3 * J 1 ) COEFF 

DEFL0820 


WRITE ( 3 • K ) COEFR 

DEFL0830 


CO 117 J = 1 , II 

DEFL0840 

117 

COEFF (J) = COEFR! J) 

DEFL0850 

120 

READ (3*1) COEFR 

DEFL0860 


ZM x CCEFR(K) / COEFF (K ) 

D6FL0870 


COEFR! K ) = 0.0 

DEFL0880 


J ~ K ♦ 1 

DEFL0890 

130 

COEFR! J) = COEFR (J) - ZM ♦ COEFF (J) 

DEFL0900 


IF t J . EG. I EQ ) GO TO UO 

DEFL 09 10 


J = J + 1 

DEFL0920 


GO TO 130 

DEFL 09 30 

uo 

COEFR! J + 1 ) = COEFR ( J + 1 ) - ZM * C0EFF(J+1) 

DEFL 09*0 


WRITE (3*1) CUEFR 

DEFL 09 50 


IF,{ I .EG. LEG ) GO TO 150 

DEFL0960 


I = 1 + 1 

DEFL0970 


GO TO 120 

DEFL0980 

150 

IF ( K .EG. 1 EQ - 1 ) GO TO 160 

DEFL0990 


K = K t 1 

DEF L 1000 


GO TO 100 

DEFL1010 

160 

CONTINUE 

DEFL1020 


READ ! 3 * I E Q ) CUEFF 

OEFL 1030 


C l S PL A ( IEQ ) x CUEFF ( I E G + 1) / COEFF ( I EQ ) 

DEFL10A0 


I = IEC - 1 

DE F L 1050 

210 

READ (3*1) CUEFF 

OEFL 1060 


J = 1 ♦ 1 

DEFL 1070 


S x U.O 

DEF LI 080 

22 0 

S = S + COEFF! J) * 0 ISP LA! J 

0EFL1O9O 


IF ( J .EG. I E v. ) GO TO 230 

DEFL 1100 


J = J + 1 

DEFL 11 10 


GO TO 220 

OEFL 1120 

2 30 

CISPLA! I ) = ( CUEFF ( l EG + i ) - S) / COEFF! I) 

DEFL 11 30 


IF ( I .EC. i ) GO TO 24C 

DEFL 1U0 


1 = 1-1 

DEFL1150 


on TT 7 1 0 

DEFL 1 160 
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2 AO CONTINUE 

FIND ( 3 • l ) 

DO 260 I = l, NT 
LA = NEXT! !« 1) 

LB = NEXT! 1,2) 

LC * NEXT ( 1,3) 

NA * 6 * IPOS (LA) 

NB = 6 * I POST L B ) 

NC = 6 * IPOS(LC) 

DO 250 J = 1,6 

IF ( IPOS(LA) .LT. 0 J GO TO 2A3 
DI SPL < J, I > * D I SPL A < NA + J) 

24 3 IF ( IPOS (LB) .LT. 0 ) GO TO 2A6 
DlSPLU + 6,1) x D 1 SPL A( NB + J ) 

246 IF T I POST LC ) .LT. 0 ) GO TO 250 
D I S PL ( J ♦ 1 2 , I I = DI SPLA4NC + J) 

250 CONTINUE 
260 CONTINUE 
FIND ( A * I ) 

WRITE (6,2/0) 

270 FORMAT ( 1HI/A3X, IAHCOMMON SYSTEM / 

l AOX ,2 OHDE FLECTION PRINTOUT //8X » 8HNGDE N0.,6X,IHX, 

I 9X , IHY , 9X , 1 HZ , 1 IX , 1HU * 14X , 1HV, 1 4X , 1HW , l OX , 6HTHE TAX , 9X , 6HTHE T AY/ ) 
J = 0 

00 280 I = 1 , NP 
LA ' = I 

K 35 6 * I POS (LA) 

DI = 0.0 
D2 = 0.0 
03 = 0.0 
DA =0.0 
D5 = 0.0 

IF ( IPOS ( L A ) .LT. 0 ) GO TO 275 
D I = 0 I SPL A ( K+ 1 ) 

02 = C l S PL A ( K + 2 ) 

03 = C I SPL A ( K + 3 ) 

DA = D IS PL A ( K + 4 ) 

05 = D I SPL A ( K>5 ) 

275 J = J + 1 

IF ( J . EQ • 50 ) WRITE (6,270 
IF ( J .EG. 50 ) J = 0 

280 WRITE (6,290) I , X ( I ) , Y(I > , Z ( I) ,DI , D2 , D3,D4,D5 
290 FORMAT ( IOX, 15, 3F 10.3, 6E 15.5) 

K 1 = ~A9 
K2 = 0 

DO 300 I = 1 , A 
K 1 = K 1 + 50 
K2 = K2 ♦ 50 

300 WRITE! 3 • I ) ( ( D I SPL ( J , K ) , J = 1 , l 8 ) ,K=Kl ,K2) 

RETURN 

END 


DEFL1170 
OEFL 1180 
DEFLU90 
DEFL1200 
DEFL1210 
DEFL 1220 
OEFL 1230 
DEFL1240 
DEFL 1250 
OEFL 1260 
OEFL 12 70 
DEFL1280 
OEFL 1290 
OEFL 1300 
OEFL 13 10 
OEFL 1320 
DEFL 1 330 
OEFL 13 AO 
DEFL1350 
DEFL 1360 
OEFL 1370 
OEFL 1380 
DEFL 1 390 
DEFL 1400 
DEFL 1410 
DEFL 1420 
0EFL1A30 
OEFUAAO 
DEFL 1450 
DEFL 1460 
DEFL1A70 
OEFL 1480 
DEFL1A90 
DEFL 1500 
DEFL1510 
DEFL 15 20 
DEFL 1530 
DEFL 1-540 
DEFL 1 550 
DEFL 1560 
DEFL 1570 
DEFL 1580 
OEFL 1 590 
DEFL 1600 
DEFL 1610 
DEFL 1620 
DEFL 1630 
DEFL 1640 
OEFL 1650 
DEFL 1660 
DEFL 1670 
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o o o 


SUBROUTINE AS SEMI 

assemble the kaa and kab portions of the common stiffness matrix 

FOR EACH SUB-SYSTEM. 


COMMON X 


t 


200 ) , 
PRESSEt 200) , 
RAPANGI 100) , 
THHUB ( 100) , 

RHU , OMEGA , 
NGENL I , LINE! 


Y ( 200) 

XL { 200,3) 
ZGL ( 100) 

TNT IP < TOO) 


l t 200) , TH 

YL ( 200,3) , 

RHUB ( 100) , RTIP 

PRE SSL (100,15) ,EDCM 


( 200 ) 


100 ) 

3,3) 


NT 


POISSU , YOUNGS , RADGEN , 

, NPRES(lOO) , NEXT < 200,3) , NP 
ELMSM (6,6) , AMN IN ( 6,6) , ELBSMI9,9) , ABNIN(9,9) , 

PFLGNI 9, i ) , CFLGN ( 18, 1 ) , EL ST IF { 1 8, 18 ) , ECST IF ( 18 * 18 ) 

PFCGNt 18,1), CFCGNt 18 , 1 ) , MEX.(200«8)» IMEX(200>, FORCE ( 
200,6) 

COMMON / MANE / NSUBS , I PO S ( 200 ) , NB T $ ( 1 0 , 1 5 ) , NI T S ( i 0 , 1 5 ) , NBN ( 1 0 ) , 
1 INTN(IO) 

DIMENSION KAA ( 90 , 90 ) , KAB(90,90) , ME XT ( 8 ) 

REAL KAA, KAB 
KREC = 0 

= 1 , NSUBS 


DO 110 I 
KAAM = 0 
IEQ1 = 6 
DO 5 J = 
DO 5 K “ 
KAA (J, K ) 
K AB ( J , K ) 


* NBN( I ) 

1,90 
1,90 
- 0.0 
= 0.0 
J1 = NBTSI I, 1 ) 

J2 = NBT S ( I , N BN ( l ) ) 

DO 90 J = Jl, J2 

IF (J „NE • NBTS( I , KAAM+ 1 ) ) GO TO 90 
KAAM = KAAM + 1 
I ME XT = IMEXU) 

00 10 K - 1 , I MEX T 
10 MEXT(K) = ME X ( J , K ) 

DO 85 K = 1 , I MEX T 
K2 = MEXT(K) 

FINO ( i»K2 ) 

LA = NEXT ( K2 , l ) 

LB = NEXT ( K2 * 2 ) 

LC = NEX T ( K2 , 3 ) 

IF II .EU. 1) GO TO 15 


15 


IF 

(I .GO. NSUBS) 


GO TU 

20 





IF! 

I I LA 

.LT. 

J.l-1 

) 

.OR. 

(LA 

.GT. 

J 2 ) ) 

.OR. 



{ (LB 

.LT. 

J 1-1 

) 

.OR. 

(LB 

.GT. 

J2) ) 

.OR. 



( ( LC 

.LT. 

Jl-1 

) 

.OR . 

(LC 

.GT. 

J2 ) ) ) 

GO TC 

85 

GO 

TU 25 










IF 

( I LA 

.GT, 

J2 ) 

• 

OR. (LB . 

GT. J* 

2) .OR 

. (LC 

.GT 

GO 

TU 25 










IF 

{ (LA 

.LT. 

J'l-1 

i 

.OR. 

(LB 

.LT. 

Jl-1 ) 

.UR. 

(LC 


l 85 


ASM 1 00 1 0 
ASM 1 0020 
A SMI 0030 
ASM! 00 AO 
AS M 1 0050 
ASM 10060 
ASM! 0070 
AS Ml 0080 
AS Ml 0090 
AS Ml 01 00 
ASMiOliO 
AS M I 0 1 20 
AS M 1 0 1 30 
ASM 1 0 1 AO 
ASM10150 
AS Ml 0 160 
AS M 1 0 1 70 
ASM10180 
ASM10190 
AS Ml 0200 
ASM 102 10 
ASM i 0220 
ASM 10230 
AS M102A0 
ASM 10250 
ASM10260 
ASM 1 02 70 
ASM! 0280 
ASM 10290 
AS M 1 0300 
ASM 1 03 10 
AS Ml 0320 
ASM 10330 
ASM103A0 
ASM10350 
AS Ml 0360 
AS M 1 0370 
AS M 1 0380 
ASM10390 
ASM10A00 
ASM10A10 
ASM10A20 
ASM10A30 
AS Ml 0 A AO 
ASM10A50 
ASM10A60 

J 2 ) ) GO TO 85 A S Ml 0 A 70 

AS Ml OA 80 

.LI. Jl-in GO TO ASM10A90 
ASM 1 050C 


25 12 

= NBN ( I ) 




ASM! 0510 

NA 

= -1 




AS Ml 0520 

NB 

* -1 




AS M l 05 30 

NC 

= -1 




AS M 1 05 AO 

DU 

30 L = 1 

t L 2 



ASM! 0550 

IF 

(L A . EQ . 

NOT SC I , L) ) 

NA = b* 

(L-li 

AS Ml 05 60 

IF 

(LB .Eg. 

NB TS ( I , L ) ) 

NB = 6* 

(L-l) 

AS Mi 05 70 

IF 

(LC • E 0 . 

MOTS (I , L ) ) 

NC = 6* 

( L- l ) 

ASM 10580 
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30 

CONTINUE 


AS Ml 05 90 


L 2 = INTN( I ) 


AS M 1 0600 


00 35 L = 1 « L 2 


AS M 1 06 1 0 


IF (LA . EG- imSUrtl! NA 

= 6* ( L+NBN( I 1— 1 ) 

A SMI 0620 


IF (LB • EQ. NITSt hi)) NB 

= fc* ( L +N8N ( I )•— .1 ) 

ASM10630 


IF (LC .EQ. NirS(I,LH NC 

= 6* ( L+NBN ( I )~l ) 

AS Ml 0640 

35 

CONTINUE 


ASM 10650 

45 

REAO 1 1 • K 2 ) ECSTIF 


A SM 1 0660 


00 80 L = 1,6 


AS Ml 0670 


IF (LA .EQ. J) I NO 1 = L 


ASM10680 


IF (LB .EQ. J) I NO l - L + 

6 

ASM10690 


IF (LC .EQ. J) l NO 1 s L + 

12 

ASM10700 


M 1 = 6* ( K AAM- 1 ) ♦ L 


AS Ml 07 10 


CO 80 M = 1 # 6 


ASM10720 


KA = NA + M 


ASM 10730 


KB * NB ♦ M 


A SM 1 0740 


KC = NC + M 


AS Ml 0750 


IF (NA .LT. 0) GO TO 55 


ASM10760 


IF (NA .GT. 6* (N0N II )-l)) 

GO TO 50 

ASM 107 70 


K AA( Ml » K A ) * KAA(HlfKA) + 

ECSTIF ( I.ND1 » M J 

ASM10780 


GO TO 55 


AS Ml 0790 

50 

KA * M + NA - I EQ 1 


AS M 10800 


KAfl(Ml.KA) = KAB(Ml,KA) + 

ECSTIF* INOI , HI 

ASM 108 10 

55 

IF (NB .GT. 6*(NBN( I )-l ) ) 

GO TO 60 

ASM10820 


KAA ( Ml ,K6 ) = KAA(Mi,KB) + 

ECSTIF ( I NO 1 , M+6 ) 

ASM 1 0830 


GO TO 65 


AS M i 08 40 

60 

KB = M + NB - ! EQ 1 


ASM10850 


K AB ( M L t K B ) = KAB(M1,KB) + 

ECSTIF! INDl* M+6) 

ASM! 0860 

65 

IF (NC .LT. 0) GO TO 75 


AS Ml 08 70 


IF (NC .GT. 6* ( NBN ( I )-l) ) 

GO TO 70 

ASM10880 


KAA(Ml # KC) = KAA { M l * KC ) + 

ECSTIF* I NO l, M+12) 

ASM10890 


GO TO 75 


ASM l 0900 

70 

KC = M + NC - I:EQ1 


ASM10910 


KAB(MUKC) = KAB ( M 1 , KC ) + 

ECSTIF (IND1, M+12) 

ASM 10920 

75 

CONTINUE 


ASM10930 

BO 

CONTINUE 


ASM! 0940 

85 

continuf 


AS M 1 0950 

90 

CONTINUE 


AS M10960 


K 1 = -9 


ASM10970 


K2 = 0 


A SM 1 0980 


00 95 L * 1,9 


ASM! 0990 


KREC = KREC ♦ 1 


ASM11000 


IF ( K2 .GE. lEOi ) GO TO 

95 

ASM 1 10 10 


K1 * Kl + 10 


ASM11020 


K2 = K 2 + 10 


AS M 1 1030 


WRITE ( 3 * KREC ) ( (KAAIK, J ) 

» J *= 1 , 90 ) , K = K1 ,K2 ) 

AS Ml 1040 

95 

CONTINUE 


AS Ml 1050 


K 1 - - 9 


A SMI 1060 


K2 = 0 


AS Mi 1070 


00 100 L = 1,9 


ASMU080 


KREC = KREC + l 


ASM11090 


IF ( K 2 .GE. 1EQI ) GU TO 

100 

ASM11100 


K 1 = K 1 + 10 


ASM! 1110 


K 2 = K2 * 10 


AS M 1 1 1 20 


WRITE nVKREC) ( ( KAB ( K , J ) 

, J = 1 ,90) , K = K 1 ,K2 ) 

ASM11130 

100 

CONTINUF 


ASM! 1140 

110 

CONTINUE 


ASM! 1150 


k FTUKN 


ASM 11 160 


END 


ASM11170 


113 





SUBROUTINE ASSEM2 

C ASSEMBLE THE KBA AND KBB-l PORTIONS OF THE COMMON STIFFNESS 

C MATRIX FOR EACH SUB-SYSTEM. 

C 

COMMON XU I 200) , Y I 200) , Z I 200) , TH I 200) 

l PRFSSE ( 200) , XL t 200,3) , YL C 2 CO, 3) , 

RAPANGI 100) , ZGL < 100) , RHUB I 100) , RTIP I 100) 

THHUB I 100) , THTIP t 100) , PRESSL (100,15) » EDCM I 3,3) 

RHO , UMEGA , PQISSU , YOUNGS , RADGEN , 

NGENLI , LINE1 , NPRESUOQ) , NEXT I 200,3) , NP , NT , 

ELMSM 16,6) , AMN IN 1 6,6) , EL8SMI9,9) , ABNIN 19,9) , 

PFLGN (9,1) , CFLGN (18,1) , ELST IF { 18 , 1 8 ) , ECSTIFM8, 18) 
PFCGN I 18, 1 ) , C F C GN I 18, 1 ) , MEX( 2C0,8) , l ME X t 200 ) , FORCE ( 
200,6) 

COMMON / MANE / NSUB S, IPOS ( 200 ) ,NB TS t 10, 15 ) ,NI TS ( 10 , 15 ) , NBNI 10 i , 
1 INTN(IO) 

0 1 MENS I UN KBA I 90,90), KBB(90,90), MEXTI8) 

REAL KBA, KBB 
KREC * 18 ♦ NSUBS 
00 135 I = 1, NSUBS 
KBAM = 0 

l EG 1 = 6 * I NT NT I ) 

IEC2 = 6 ♦ NBNt I ) 

DO 5 J = 1,90 

DO 5 K = 1,90 

KBATJfK) = 0.0 
5 KBB(JfK) = 0.0 
J 1 * N I T S (1 , 1 ) 


J2 = NITSI I , INTNt I ) ) 

DO 90 J = J 1 , J 2 

IF IJ .ME. NITSI I tKBAM+i ) ) GO TO 90 
KBAM = KBAM + l 
I ME XT = IMEXU) 

CO 15 K = 1, IMEXT 
15 MEXTIK) = MEX(JfK) 

DO 85 K = l, IMEXT 
K2 = MEXTIK) 

FIND I 1 • K 2 ) 

LA = NFXTIK2, 1 ) 

L8 = NFX T IK2 , 2 ) 

LC = NEXT I K2 , 3 ) 

L2 = NBN I I ) 

N A = - 1 
NB = -l 
NC = -1 

on 30 L = 1 , L 2 


IF 

(LA .EQ. 

NBTST I , L ) 

) NA 

= 

6* T L- 1 ) 

IF 

(LB .EC. 

NBTS( I , L ) 

) NO 

= 

6* I L— 1 ) 

IF 

(LC .EC, 

NBTS { I ,L ) 

i NC 


6*(L— l ) 

CONTINUE 





L 2 

= I NT N ( I ) 





DU 

35 L - l, 

L 2 




IF 

(LA * EQ, 

NITSI I , L ) 

) NA 

- 

6* (L + 

IF 

(LB .EQ. 

NITSI I ,L ) 

} NB 


6* IL ♦ 

IF 

(LC .EQ. 

NITSI I , L ) 

) NC 

•= 

fc* TL + 


35 CONTINUE 
*5 READ I 1 • K 2 I ECSTLF 
CO 80 L = 1,6 


AS M2 00 10 
AS M2 00 20 
ASM20030 
ASM200A0 
,ASM20050 
ASM20060 
, ASM20070 
, ASM20080 
ASM20090 
ASM20100 
AS M20 1 10 
, ASM20120 
ASM20130 
ASM201A0 
AS M20150 
ASM20160 
ASM20170 
ASM20180 
ASM20190 
AS M2 02 00 
ASM202 10 
AS M20220 
ASM20230 
AS M2 02 AO 
ASM20250 
AS M20260 
AS M20270 
ASM20280 
ASM20290 
ASM20300 
ASM20310 
ASM20320 
ASM20330 
AS M203AO 
AS M2 03 50 
ASM20360 
AS M2 03 70 
AS M20380 
AS M20390 
ASM2OA00 
ASM20A10 
AS M2 OA 20 
AS M20A30 
ASM20AA0 
ASM20A50 
ASM20A60 
AS M20A70 
ASM20A80 
ASM20A90 
AS M20500 
AS M2 05 10 
ASM20520 

NBNt I ) - 1 ) AS M2 05 30 

NBN ( I ) ~ 1 ) AS M2 05 AO 

NBNT I )-l) ASM20550 

AS M2 0560 
ASM20570 
AS M2 05 80 


11 A 




IF (LA • EQ . J) IND'l = L 


AS M2 0590 


IF ( L8 .EU. J) I NO 1 = L ♦ 

6 

ASM20600 


IF (LC .EO. J) IND1 = L ♦ 

12 

AS M2 06 1 0 


Mi = 6 * (KBAM-1 ) + L 


AS M2 06 20 


DO 80 M = 1,6 


AS M2 06 30 


KA * NA + M 


ASM20640 


KB * NB + M 


A S M2 0650 


KC = NC f M 


AS M2 0660 


IF (NA .LT. 0) GO TU 55 


ASM20670 


IF (NA .GT. 6* ( NBN ( I ) - 1 ) ) 

GO TU 50 

ASM20680 


KBA(M1,KA) = KBA(Ml.KA) + 

EC S T I F ( I NO 1 , M ) 

A S M2 0690 


GO TO 55 


AS M2 0700 

50 

KA = M NA - I EQ2 


ASM20710 


KBB(Ml,KA) = KBB ( M 1 ,K A ) ♦ 

EC S T IF ( I ND 1 , M ) 

ASM20720 

55 

IF (NB .GT. 6 * ( NBN { I )-!)) 

GO TO 60 

AS M2 0 7 30 


KBA ( Ml , Kb ) = KBA(M1,KB) + 

EC S T I F ( I ND 1 , M + 6 ) 

AS M2 0740 


GO TO 65 


AS M2 07 50 

60 

KB * M + NB - IEU2 


ASM2G760 


KBB ( Ml ,KB) - KBB t M l * KB 1 ♦ 

ECST IF ( I N01 , M+6 ) 

A S M2 0 7 7 0 

6*5 

IF (NC .LT. 0) GO TO 75 


AS M2 07 80 


IF (NC .GT. 6* ( NBN ( I >-i ) ) 

GO TU 70 

ASM20790 


KBA ( Ml «KC ) = KBA(Mi,KC) ♦ 

EC ST IF { I NO 1 , M+ 1 2 ) 

ASM20800 


GO TO 75 


A S M2 08 1 0 

70 

KC = M ♦ NC - IEQ2 


ASM20820 


KBB ( Ml , KC ) - KBB (M l , KC.) ♦ 

FC ST I F ( INDlf M+12) 

ASM20830 

76 

CONTINUE 


ASM 2 0840 

80 

CONTINUE 


A S M2 0850 

85 

CONTINUE 


AS M2 0860 

90 

CONTINUE 


ASM20870 


K2 * l NTN ( I) * 6 


ASM20880 


DO 120 K = 1 , K2 


AS M2 08 90 


IF ( KBB ( K , K ) ) 105,95,105 


AS M2 0900 

95 

WRITE (6,100) I 


ASM20910 

100 

FORMAT (22H KBB UF SUB-SYSTEM NO., 13, 13H IS SINGULAR) 

ASM20920 


NSUBS = -NSUBS 


ASM20930 


RETURN 


AS M2 0940 

105 

X = 1.0 / KBB ( K , K ) 


AS M2 09 50 


KBB ( K , K ) = 1.0 


ASM20960 


DO 110 J = 1 , K2 


ASM20970 

i 10 

KBBIK, J) = KBBIK, J ) * X 


AS M2 0980 


IF (K-K2) 115,125,115 


AS M20990 

115 

M = K + l 


ASM21000 


00 120 N = M,K2 


A S M2 1 0 1 0 


X = KBB ( N, K ) 


AS M2 1020 


KBB ( N, K ) = 0.0 


AS M2 1030 


00 120 J = i,K2 


ASM 2 1 040 

120 

KBB ( N , J > = KBB(N, J ) - X * 

KBBIK, J ) 

ASM21050 

125 

LL = K2 - 1 


AS M2 1060 


DO 130 J = 1 , LL 


AS M2 1070 


M = J + 1 


ASM21080 


DO 130 K = M,K2 


A S M2 1 090 


X = KBB ( J , K ) 


AS M2 1 100 


K BB ( J , K ) = 0.0 


AS M2 1 1 ID 


DO 130 L = 1 , K 2 


ASM21120 

130 

KBB ( J » L ) = KBB 1 J » L ) - KBBIK, L ) * X 

AS M2 1 1 30 


K1 = -9 


AS M2 1 140 


K 2 = 0 


AS M2 1 150 


00 131 L = 1,9 


ASM2 1160 
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KREC = KREC + 1 
I f l K2 . GE • ! EQ l ) GO TO 131 
K1 = K 1 * 10 
K2 = K2 ♦ 10 

WRITE ( 3 • K REC ) U K BA ( K * J ) , J= 1 , 90 )♦ K =K 1 ,K2 ) 

131 CONTINUE 
K 1 = -9 
K2 = 0 

CO 132 L = 1,9 

KREC * KREC ♦ 1 

IF ( K2 .GE. I EQ l ) GO TO 132 

K 1 = K 1 + 10 

K2 = K2 ♦ 10 

WR I TE ( 3 • KREC 1 ( ( KtiB { K , J ) f J = 1 v 901 #K=K 1 f K2 ) 

132 CONTINUE 
133 CONTINUE 

RETURN 

END 


AS M2 1 1 70 
AS M2 11 80 
AS M2 1190 
ASM21200 
AS M2 l 2 10 
AS M2 1220 
AS M2 12 30 
AS M2 1240 
AS M2 1250 
AS M2 1260 
ASM21270 
ASM21280 
AS M2 1290 
AS M2 1300 
AS M2 1310 
AS M2 132 0 
AS M2 1330 
AS M2 1 340 
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SUBROUTINE CALC 

CALCULATE THE SUB-SYSTEM PORTION OF THE SYSTEM STIFFNESS 
MATRIX AND SYSTEM BOUNDARY FORCE COEFFICIENT MATRIX. 

COMMON / MANE / NSUB S I PUS i 2CO ) , NB T S ( L 0, 1 5 ) , NI TS U 0 , 1 5 ) , NBN ( 10 1 , 
1 INTNC10) 

REAL KSS 

DIMENSION 8(90,90), KSSI50 r 90), A(90,90> 

J3 * 36 * NS UBS 
= A5 * NSUB S 
00 20 I = 1 tNSUBS 
IEC1 = 6 * NBN( I ) 

IEC2 = 6 * IN TNI I ) 

KA * 18 * I - 9 

K I = ~9 

K2 = 0 

00 I l * if 9 
KA = KA + l 

IF ( K2 .GE. IEQl ) GO TO i 
K I = K 1 f 10 

K2 * K2 + 10 

READ ( 3* KA ) ({ A l K , J ) , J = 1 , 90 ) , K=Kl , K2 ) 

1 CONTINUE 

KB = 18 * ( NSUBS *► I ) - 9 
Ki * -9 
K 2 = 0 

DO 2 L = 1,9 
KB = KB + 1 

IF ( K2 .GE. I EQ2 ) GO TO 2 
Kl - Kl ♦ 10 

K2 = K2 + 10 

READ (3'KB) ( ( B I K,J),J=1,90), K=K 1 , K 2 I 

2 CONTINUE 
J1 - IEQl 
J2 = I ED 2 

IF ( J1 .GT. 50 ) J1 = 50 
CO 3 J = l,Jl 
DO 3 K = 1 , J 2 
KSS ( J , K ) = 0.0 
DO 3 L = 1 , J2 

3 KSS ( J , K ) = KSS ( J » K ) ♦ A ( J , L ) * B ( L »K ) 

Kl * -9 

K2 = 0 

DO 4 L •* 1,5 
J3 ~ J3 ♦ 1 

IF ( K2 .GE. IEQl ) GO TO 4 
Ki - Kl + 10 

K2 = K2 + 10 

WRITE ( 3 * J 3 1 ( ( KSS ( K , J I f J = l , 90 ) , K =K l , K2 ) 

4 CONTINUE 

1 F { I EM .LE. 50 > J3 = J3 * 4 

IF ( IEQl .LE. 50 ) GO TO 7 

J1 = IEQl - 50 

DO 5 J = 1,J1 
DO 5 K - L , J 2 
KSS I J , K ) = 0.0 
no 5 L = 1 , J 2 

5 K S S { J , K ) = K SS ( J ,K ) ♦ A ( J + 5 0 , L ) * B ( L , K ) 


CALC0010 
CALC0020 
CALC0030 
CALC0040 
CALC0050 
CAL COO 60 
CALCOO 70 
CALC0080 
CALC0090 
CALCOIOO 
CALC 01 10 
CALC0120 
CALC0130 
CALC01 40 
CALC0150 
CALC 01 60 
CALC0170 
CALC0180 
CALC0190 
CALC0200 
CALC0210 
CALC0220 
CALC0230 
CALC0240 
CALC0250 
CALC0260 
CALC 02 70 
CALC0280 
CALC0290 
CALC0300 
CALC0310 
CALC0320 
CALC0330 
CALC0340 
CALC0350 
CALC0360 
CALC0370 
CALC0380 
CALC0390 
CALC 04 00 
CALC0410 
CALC0420 
CALC0430 
CALC 0440 
CALC0450 
CALC 0460 
CALC 04 70 
CALC0480 
CALC0490 
CALC0500 
CALC 05 l 0 
CALC0520 
CALC0530 
CALC 05 40 
CALC 0550 
CALC0560 
CALC0570 
CAL CO 5 80 
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K 1 = -9 

CALC0590 


K2 =0 

CALC0600 


ii 

_i 

C 

o 

Q 

C A LC 0610 


J 3 = J 3 + 1 

CALC0620 


IF < K2 .GE. ICQ 1-50 ) GO TO 6 

CALC0630 


K1 * Kl 4 10 

CALC0640 


K2 = K2 ♦ 10 

CALC0650 


WRITE ( 3 * J 3 ) ( ( KSS ( K » J1 ».J*l , 90 ) * K*K 1 »K 2) 

CALC0660 

6 

CONTINUE 

CALC0670 

7 

KB = KB - 18 

CALC0680 


Kl = -9 

CALC0690 


K 2 = 0 

CALC0700 


DO 8 L = 1 » 9 

CALC0710 


KB - KH ♦ 1 

CALC0720 


IF ( K 2 .GE. IEQ2 ) GO TO 8 

CALC0730 


K l = K 1 ♦ 10 

CALC0740 


K2 * K2 + 10 

CALC0750 


READ ( 3 * KB ) I (8{K,J),J=1, 90 ) » K=K 1 » K2 ) 

C ALC0760 

8 

CONTINUE 

CALC0770 


Jli = IEQ1 

CALC0780 


J1 » IEQ1 

CALC0790 


IF { Jll .LE. 50 ) GO TO 11 

CALC08Q0 


JU = Jli - 50 

CALC0810 


DO 9 J = i,Jli 

CALC0820 


DO 9 K = 1,J1 

CALC0830 


AtJ+50,K) = 0.0 

C ALC0840 


DO 9 L = l,J2 

CALC0850 

9 

AU+50.K) = A ( J ♦ 50 , K ) + K S S ( J » L ) * B(L,K) 

CALC0860 


J3 = J3 - 9 

CALC0870 


Kl * -9 

CALC 08 80 


K 2 = 0 

CALC0890 


-O 

n 

— j 

o 

o 

o 

CALC0900 


J3 = J 3 + l 

CALC0910 


IF ( K2 .GE. IEQ1 ) GO TO 10 

C ALC0920 


Kl = Kl ♦ 10 

CALC 09 30 


K2 = K2 + 10 

CALC0940 


READ < 3 * J 3 I I (KSS(K V J), J = 1 ,90 ) , K=K 1 , K2 ) 

CALC0950 

10 

CONTINUE 

CALC0960 


J 3 - = J 3 +4 

CALC0970 

11 

Jll = IE.Q1 

CALC0980 


IF ( Jll . GT. 50 ) Jll = 50 

CALC0990 


GO 12 J = l f Jll 

CALC 1000 


DO 12 K = l,Ji 

CAL C 10 10 


A ( J * K ) = 0.0 

CALC 1020 


DO 12 L = 1 , J2 

CALC1030 

12 

A ( J » K ) = A { J » K ) ♦ KSS I J , L ) * B(L,K) 

CALC 1 040 


KA = KA - 18 

CALC 1050 


Kl = -9 

CALC 10 60 


K2 = 0 

CALC 10 70 


DO 14 L = 1*9 

CALC 1080 


KA = KA + 1 

CALC 1090 


IF { K2 .GE. I h Q 1 ) GU TO 14 

CALC 1100 


Kl = Kl + 10 

CALCiliO 


K2 = K2 ♦ 10 

CAL Cl 1 20 


READ { 3* KA) ( IB(K,J) , J = 1 ,90) *K=K1 *K2 ) 

CALC 11 30 

14 

CONTINUE 

CALC 11 40 


DO 15 J = i,Jl 

CALC1150 


DO 15 K = 1,J1 

CALC 1 160 
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15 B ( J,K) = B ( J t K ) - A { J i K ) 

K 1 = -9 

K? = 0 

DO 16 L = l » 9 

J4 •* J 4 ♦ 1 

IF ( K 2 .GE. IEQl ) GU TU 16 
Ki = K 1 ♦ 10 

K 2 * K2 ♦ 10 

WRITE ( 3 * J A ) ((B (K) J ) tJ-l »90) »K«K1 * K 2 ) 

16 CONTINUE 
20 CONTINUE 
RETURN 
END 


CALC 1 1 IQ 
CALC 1 1 80 
CALC 1 1 90 
CALC 1200 
CALC 1210 
CALC 1 220 
CALC 12 30 
CALC 1240 
CALC1250 
CALC1260 
CALC1270 
CALC 1280 
CALC 1 290 
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on 


2 


3 

A 


5 


SUBROUTINE ASS EM 3 ( NBNUDE ) 

ASSEMBLE THE SUB-SYSTEM MATRICES INTO THE SYSTEM MATRIX. 
REAL KSS 


COMMON 

X t 

200) 


Y t 200) 

, 

Z 

( 200) , TH 

( 200) 

i 

PRESSEt 

200) 

t 

XL < 200,3) 

, 

YL ( 

200,3) , 


2 

RAPANCt 

100) 


ZGL t 100) 

, 

RHJB 

t TOO) , RTIP 

t 100) 

3 

THHUB t 

TOO) 

, 

THTIP t 100) 

t 

PRE SSL t 100,15) , EDCM 

t 3,3) 

A 

RHG , OMEGA 


POISSO , YOUNGS , RADGEN , 


5 

NGENLl 

, LINEl 

, NPREStlOO) 

, 

NEXT 

t 200, 3) , NP , 

NT , 


6 ELMSM t 6, 6 ) , AMNINt6,6> , ELBSM<9,9) , ABNlNt9,9) , 

7 PEL ON I 9,1) , CEL GN t 18 f 1 ) , EL 5TI F t 1 8 , 18 ) , EC S T I F ( 1 8 , 18 ) 

8 PFCGNtlBtl), CECGN (18,1), M.EX (.2-00**) « IMEX1200), FORCE ( 

9 200,6) 

COMMON / MANE / NSUBS , IPOS ( 200 I , NBTSt 1 0, 1 5 ) ,Nl TS t 10 , i 5) ,NBN ( 10 ) , 
1 INTN(IO) 

DOUBLE PRECISION COE EE 

DIMENSION COEFFl 301 ) , F190), K$S(90,90) , NBNEWL10) 

NBNEWll) = NBNtl) 

DO 2 I = 2 , NSUBS 

NBNEUU) = NBNtl) - NBNEHU-1) 

NBNODE = NBNtl) 

J2 = NBTSt l, NBNODE) 

J1 * IPOSt J2) 

N SUB = NSUBS -i 
DO A I = 2 vNSUB 
J =* NBNtl) 

DO 3 K s 1,J 
J2 = NBTSt 1 , K ) 

IE t IPUSIJ2) ,LE. J1 ) GO TO 3 
Jl = I PUS ( J2 ) 

NBNODE = NBNODE ♦ 1 

CONTINUE 

CONTINUE 

II = 6 * NBNODE ♦ 1 
CO AO I * 1, NSUBS 
K 1 = 36 * NSUBS + 9 * (I-.ll 
I.E01 - 6 * NHNt I ) 

J? = -9 
J 3 = 0 

DO 5 L = 1,9 

K 1 = K 1 4- 1 

IE < J 3 • G E • I EQ 1 ) GO TO 5 
J 2 * J 2 + 10 
J 3 * J 3 ♦ 10 

READ f 3 • K 1 ) ( ( KSStK, J) , J = 1 , 9 0 ) , K = J 2 , J 3 ) 

CONTINUE 
J2 = NBNt I ) 

J 3 = iNTNtl) 

DO 10 J * 1, J2 
DO 10 K = 1,6 
Jl * 6* t J-l ) ♦ K 
FIJI) = 0.0 
DO 10 L = 1 f J 3 
DO 10 M = 1,6 
Ml = 6 * t L — 1 1 + M 

10 FIJI) = E ( J 1 ) + K SSt J 1 , Ml ) * FORCE (NI TStI ,L) ,M ) 

K 1 = AS * NSUBS + 9 * { I - 1 ) 


AS EM 30 10 
ASEM3020 
ASEM3030 
ASEM30A0 
, ASEM3050 
ASEM3060 
, ASE M3070 
, ASEM3080 
ASEM 3090 
ASEM3100 
ASE M3 1 1 0 
AS E M3 1 20 
ASEM 31 30 
ASEM31A0 
ASE M3 1 50 
AS E M3 160 
ASEM3170 
ASEM3 1 80 
ASE M3 190 
AS EM 32 00 
ASEM 3210 
AS EM 32 20 
ASEM3230 
ASEM32A0 
AS EM 32 50 
ASEM 32 60 
ASE M3 2 70 
AS EM 32 80 
ASEM 3290 
ASEM 3300 
ASEM3310 
ASE M3 3 20 
ASEM3330 
ASEM 33 AO 
ASEM3350 
AS EM3360 
ASEM 33 70 
ASEM3380 
ASE M3 3 90 
ASEM3A00 
ASEM3A10 
ASEM3A20 
ASE M3 A 30 
ASEM3AA0 
ASEM3A50 
ASEM3A60 
ASEM3A70 
ASEM3A80 
ASEM3A90 
A SEM3500 
ASEM3510 
ASEM 3520 
ASEM 3530 
ASEM35A0 
ASEM3550 
AS EM356Q 
AS EM 3570 
ASEM3580 
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11 = -9 

AS E M3 590 


L2 * 0 

AS EM 3600 


DO 11 L * 1,9 

ASEM3610 


K1 * K1 + l 

ASEM3620 


IF < L2 *GE . IEQ1 ) GO TO 11 

AS EM3630 


Li * LI ♦ 10 

AS EM 3640 


L2 = L2 ♦ 10 

ASEM3650 


READ (3'K1) KKSStK, J ) , J=l,90),K=L 1,12) 

ASEM3660 

11 

CONTINUE 

AS EM36 70 


J 1 - I - 2 

AS EM 3680 


I COL 1 = i 

ASEM3690 


IF < I • L E* 2 ) GO TO 13 

ASEM3700 


CO 12 J = 1,J1 

ASEM3710 

12 

icon = IC0L1 ♦ 6 * NBNEW(J) 

AS EM 37 20 

13 

ICQL2 = 1CUL1 + 6 * NBNM1 - 1 

ASEM3730 


K3 = ICOLi -1 

AS E M3 740 


DO 40 J * 1,J2 

ASEM3750 


00 AO K = 1,6 

ASEM3760 


00 15 L * 1,301 

ASEM3770 

15 

COEFF(L) = 0*0 

ASEM3780 


K 1 * 6 * ( J-l ) + K 

AS EM3790 


K2 * K1 + K 3 

AS EM 3800 


IF ( l .EG. 1 ) GO TO 20 

AS EM 38 1 0 


IF i J .GT. NBNEW ( !~ 1 ) ) GO TO 20 

ASEM3820 


READ ( A * K2 +200 ) COEFF 

ASEM3830 

20 

DO 26 L = ICOLi, ICUL2 

AS E M 38 40 

25 

COEFFIL) * COEFF (L ) ♦ KSSIK1, L-ICOLl+l) 

ASEM3850 


COEFF ( 1 1 ) = COEFF(Ii) - F(K1) 

ASEM3860 


IF ( I . EG • l ) GO TO 27 

ASEM3870 


IF I J *LE * NBNEW { 1^1) ) GO TO 30 

AS EM 3880 

27 

COEFF (III = COEFF III) + FORCE 1NBTS ( I , J ) ,K) 

A SEM 3890 

30 

WRITE ( 4 • K2 + 200 ) COEFF 

ASEM3900 

4U 

CONTINUE 

ASEM3910 


RETURN 

AS E M 39 20 


END 

A SEM3930 
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SUBROUTINE BOEFL I NBNUDE ) 

IMPLICIT RE AL *8 (A-H, U-Z) 

SOLVE FOR THE BOUNDARY NODE DEFLECTIONS IN THE COMMON 
COORDINATE SYSTEM 

COMMON / MANE / N SUB St IPOS 1200) »NBTSt 10* 151 *Nl TS ( 10# 15) »N8Nt 10 ) t 
I INTNCIO) 

DIMENSION COEFF! 301) , DISPLAU200) , C06FR(30I) • IDIS(300) 
DIMENSION NBNEW I 10) 

DATA I 0 I S / 300 ♦ 0 / 

IFQ = 6 * NBNUDE 
NBNEW ( l ) * NBN< II 
DO 5 I s 2» NSU3S 
5 NBNEW ( I ) = NBN(I) - NBNEW (1-1 I 

II - I EQ ♦ l 
K = l 

10 READ (4*K+200) COEFF 
I * K ♦ i 

I FI DABS ( COEFF ( K ) ) .GT • i. 00-10) GO TO 35 
.CQ 15 J M. IEQ 
J1 = J 

READ K'J+200) COEFR 

IF(DABSICOEFRIK) ) .GT. 1. 00-10) GO TO 25 
15 CONTINUE 

WRITE (6,20) 

20 FORMAT ( 32H DISPLACEMENT MATRIX IS SINGULAR ) 

NS UBS = -NSUBS 
RETURN 

25 WRITE I 4 • J 1+200 ) COEFF 
WRITE I 4 • K + 200 ) COEFR 
DO 30 J = I, I 1 
30 COEFFU) = CUEFRI J ) 

35 READ (4* 1+200) COEFR 

ZM = C0EFR1K) / CUEFF(K) 

COEFR(K) = 0,0 
J * K + i 

40 COE FK I J ) = COEFR ( J ) - ZM * COEFFU) 

IF (J .EQ. IEQ) GO TO 45 
J • J + 1 
GO TO 40 

45 COEFR ( J + 1 ) = COEFR ( J + 1 i - ZM * COEFFU + i) 

WRITE (4*1+200) COEFR 
IF (I .EG. IEQ) GO TU 50 
I - l + 1 
GO TO 35 

50 IF (K .EQ. IEQ - 1 ) GO TO 55 
K * K + i 
GO TU 10 
55 K = K + 1 

READ ( 4 * K +2 00 ) COEFF 
K2 = 0 

00 60 I = 2 » NSUB S 
K 1 = K2 + 1 

K2 * K l + NBNEW I I-i ) - 1 
J 1 2 = 0 

DO 60 J = K 1 » K 2 
J 1 2 = J 1 2 + l 
Jil = NiHSI I . J12 ) 


BDEFL010 
BDEFL020 
BDEFL030 
8DEFL040 
BDEFL050 
BDEFL060 
80 E FLO 70 
BDEFL080 
BDEFL090 
BDEFLiOO 
BDEFLliO 
BDEFL120 
BDEFL130 
BDEFL140 
BDEFL150 
BDEFL160 
BOEFL 170 
BDEFL180 
BDEFLl 90 
BDEFL200 
BOEFL 2 10 
BOEFL220 
BDEFL230 
BDEFL240 
BDEFL250 
BDEFL260 
B0EFL270 
BDEFL280 
8DEFL290 
BOEFL 300 
BDEFL310 
BDEFL320 
BDEFL330 
BDEFL340 
BDEFL350 
BD6FL360 
BDEFL370 
BOEFL 380 
B0EFL390 
BDEFL400 
BDEFL4I0 
BDEFL420 
BDEFL430 
BDEFL440 
BDEFL450 
B0EFL460 
BDEFL4/0 
BDEFL480 
8DEFL490 
BDEFL500 
BDEFL510 
B0EFL520 
BDEFL5 30 
BOE F L 540 
BDEFL550 
BDEFL560 
BDEFL570 
BDEFL580 
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DO 60 K = 1,6 
L * 6 * (J-i) ♦ K 
60 IDIS(L) = 6 * IPO$< Jil I + K 

62 OISPLAdOlSCIEU) ) = CUEFFUEQ+1) / CuEFF(IEQ) 

I = I EC - 1 

.65 R E AC (A* 1+200) COEFF 

J = I + 1 

S = 0.0 

70 S = S + COEFF ( J ) • OISPLAi ID ISC J 1 9 
IF (J .EQ. I EQ ) GO TO 75 
J = J ♦ 1 

GO TO 70 

75 DISPLAUOIsmi = (C 0 EFF 1 I EQ + 1 ) - S) / COEFFU) 

IF (I .EQ. 1) GO TO 80 
1 = 1-1 
GO TU 65 
80 CONTINUE 

WRITE ( 3 • 1 ) (CIS PL At 1 ) t I * 1 .» 3 C 0 ) 

WRITE (3*2) (DISPLAC'D , 1=301,600) 

WRITE (3*3) (DISPLAt I) , 1 = 601,900) 

WRITE ( 3 * A ) (DISP.LA( I) , 1=901, 1200) 

RETURN 

END 


BDEFL590 

BDEFL600 

BDEFL610 

BDEFL620 

BDEFL630 

BDEFL6A0 

BDEFL650 

B0EFL660 

BDEFL670 

BDEFL680 

BDEFL690 

BDEFL700 

BDEFL710 

BDEFL720 

BDEFL730 

B0EFL7A0 

BDEFL750 

6DEFL760 

BDEFL770 

B0EFL780 

8DEFL790 

BDEFL800 

BDEFL810 
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SUBROUTINE ICEFL 

C SOLVE FOR THE INTERNAL NODE DEFLECT ION OF EACH SUB-SYSTEM* 

C 

COMMON X ( 200) , Y t 200) , 2 ( 200) , TH { 200) 

l PRESSEt 200) , XL ( 200,3) , YL ( 200,3) , 

R APANGI LOO) , ZGL ( 100) , RHUB i 100) , RTIP ( 100) 
THHUB { 100) , THTIP { 100) , PRESSL ( 100 , IS ) , EOCM { 3,3) 
RHO , OMEGA , POISSO , YOUNGS , RAOGEN , 

NGENLI , LINE1 , NPRES(iOO) , NEXT ( 200,3) , NP , NT , 
ELMSM 16,6) , AMN I N I 6 , 6 ) , ELBSM(9,9) , ABNIN(9,9) , 

PFLGN (9,1) , CFLGNt 18,1) , EL ST I F { 1 8, l 8 ) , EC ST I F ( 1 8, 1 8 ) 
PFCGN ( 18, L ) • CFCGN ( 18, 1 ) , MEX(2C0,B), IMEXI200), FORCE ( 
200,6) 

COMMON / MANE / NSUBS, I POS ( 200 ) , NBTS ( 10, 15) ,NI TS t 10, 15 ) ,NBN ( 10 ) , 
1 INTN(IO) 

DOUBLE PRECISION OISPLA 

DIMENSION 0 I SPL A ( 1 200 ) , A(9C,90) , B(90) , DI SPL ( 1 8 ,200 ) 

DATA OISPL / 3600*0.0 / 

READ (3*1) (DISPLAl I ) , 1=1, 300) 

READ (3*2) (OISPLAt I ), 1 = 301,600) 

READ (3*3) (DISPLAt I), 1=601,900) 

READ (3*4) (DISPLAt I), 1=901, 1200) 

DO 25 I = 1, NSUBS 

KBA = 18 * NSUBS ♦ 18 * < I— IT 

I EQ 1 * 6 ♦ INTN ( I ) 

K 1 = -9 
K2 = 0 

DO 5 L = 1,9 
KBA = KBA ♦ l 

IF ( K2 .GE. IEQ 1 ) GU TO 5 
K 1 = K 1 ♦ 10 
K2 = K2 + 10 

READ { 3 ' KBA ) ( (A(K,J),J = 1,90) ,K=K1 ,K2) 

5 CONTINUE 

J1 = I NT N ( I ) 

LI = NB\I( I ) 

DO 15 J = 1,J1 
DO 15 K = 1,6 
K 1 = 6 * ( J-l ) + K 
B ( K 1 ) = 0.0 
CO 10 L = 1 , L 1 
L 3 = NBT S( I ,L ) 

L2 = 6 * IP0SIL3) 

DO 10 M = 1,6 

Ml = L 2 + M 

N = 6 * (L-l) ♦ M 

10 8 ( K 1 ) = 6 ( K 1 ) + A ( K 1 , N ) ♦ DISPLA(Ml) 

15 9 ( K 1 ) = FORCE ( N I TS t I ,J),K) - B(Kl) 

K 1 = - 9 
K? = 0 

DU 17 L = 1,9 
KBA = KHA ♦ 1 

IF ( K 2 . GF • I EQ 1 ) GU TU 17 

K1 = Ki + 10 

K? = K2 + 10 

READ { 3 * KB A ) ( ( A ( K , J ) , J= 1 , 90 ) , K =K 1 , K 2 ) 

17 CONTINUE 

J1 = INTN(I) 


IDFL0010 
IDFL0020 
I DFL0030 
, I DF LG040 
I DFL0050 
, IDFL0060 
, I0FL0070 
I OF LOO 80 
I DFL0090 
IDFLOIOO 
, IDFLOliO 
IDFL0120 
IOFLOl 30 
IDFL0140 
IDFL0150 
I DF LO 160 
IDFL0170 
IDFL0180 
I DFL0190 
IDFL0200 
IDFL02 10 
IDFL0220 
IDFL0230 
I DFL0240 
I DEL 0250 
IDFL0260 
IDFL0270 
I DFL0280 
IDFL0290 
IOFL0300 
l DF L 03 10 
I0FL0320 
I DEL 03 30 
IDFL0340 
I DFL0350 
I DFL0360 
IDFL0370 
IDFL0380 
1 DFL0390 
IDFLOIOO 
IDFLOLIO 
I0FL0420 
I OF L 04 30 
I0FL0440 
I DEL 0450 
I OF L 0460 
IDFL0470 
I OF L0480 
I DEL 0490 
I0FL0500 
I0FL0510 
1 OF LOS 20 
I0FL0530 
IDFL0540 
I OF L 05 50 
IDFL0560 
t DEL 0570 
IOFL0580 
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LI = 6 * J1 



I0FL0590 


CO 20 J = i,Jl 



I DFL0600 


K 3 = N f T S (I * J ) 



I0FL06L0 


DO 20 K - 1,6 



I OF L 0620 


K 1 = 6 * I POS C.K3 ) + K 



I0FL0630 


K2 - 6 * { J - 1 ) ♦ K 



I OF L 06 AO 


0ISPLA(K1 ) - 0.0 



I OF L 06 50 


DO 20 L = 1 ? L 1 



IDFL0660 

20 

OISPLAIKli * 0 1 S PL A ( K 1 ) + A(K2,L) * BID 



I 0FL0670 

26 

CONTINUE 



I0FL0680 


DO 50 I * 1, NT 



I OF L 0690 


LA = NEXT ( 1,1) 



10 FLO 700 


LB = NEXT ( 1,2) 



I DFL071 0 


LC = NEX T ( 1,3) 



IDFL0720 


NA = 6 * IPOS(LA) 



IDFL0730 


NB = 6 * IPOS (LB) 



I 0FL07A0 


NC - 6 * IPOS(LC) 



I 0FL0750 


00 40 J * 1,6 



I0FL0760 


IF ( IPOS ( L A ) .LT. 0) GO TO 30 



IDFL0770 


D I SPL ( J , I ) * D I SPLAT NA ♦ J) 



I DFL0780 

30 

IF ( I PCS ( LB ) .LT. 0) GO TO 35 



I OF L0790 


01 S PL ( J+6, I ) = D I SPL A ( NB ♦ J ) 



IDFL0800 


IF { IPOS ( LC ) .LT. 0) GO TO AO 



IDFL0810 


01 SPL ( J+ 12,1) = 0 I SPL At NC + J ) 



I0FL0820 

AO 

CONTINUE 



I0FL0830 

50 

CONTINUE 



I0FL08A0 


KL = -A 9 



IDFL0850 


K2 - 0 



I 0FL0860 


DO 52 I = 1,A 



IDFL0870 


Kl = Ki * 50 



1 0FL0880 


K2 = K2 ♦ 50 



I DFL0890 


WRITE (3*1) ( (DISPL( J,K ) , J= 1 , 18 J ,K=Kl,K2) 



IDFL0900 


WRITE (6,55) 



10FL0910 

55 

FORMAT ( 1 H 1/ A 3X , l AHCOMMON SYSTEM / AOX , 

20HDFFLECT I ON 

PRINTOUT I0FL0920 


l // 8X, 8HN0DE NO., 6X, 1HX, 9X, 1HY , 9X, 

IHZ, 

MX, 1 HU , 

IAX, 1HV, IDFL0930 


2 1 A X , IHW, 10X, 6HTHETAX, 9X , 6HTHETAY /) 



I OFL 09 AO 


J “ 0 



I OF L0950 


DO 70 I = 1 , N P 



IDFL0960 


LA = I 



I0FL0970 


K * 6 * IPOS (LA) 



I OFL 0980 


01 = 0.0 



IOFL0990 


C? * 0.0 



I OFL 1000 


D 3 = 0.0 



l OFL 1010 


DA = 0.0 



I OFL 1020 


D5 = 0.0 



I OFL 1030 


IF ( I POS (LA) .LT. 0) GO TO 60 



I OFL 10 AO 


.01 = D I SPL A ( K ♦ 1 ) 



I OFL 1050 


02 = 0 ISPL A ( K+2 ) 



I OFL 1060 


0 3 = Cl SPLAT K + .3 ) 



I OFL 1070 


DA = C I S PL A ( K + A ) 



I OFL 1080 


1)6 = 0I5PLA(K+5) 



1 0 F L 1 0 9 0 

60 

J = J + 1 



I OFL 11 00 


IF (J .EQ. 50) WRITE (6,55) 



T0FL1110 


IF (J .EG. 50) J = 0 



IDFL1120 

70 

WRITE (6,80) I, X(I), Y ( I ) , Ztl), Dl, 02, 

03, 

DA, 05 

I OFL 11 30 

80 

FORMAT (10X, 15, 3F10.3, 5E15.6) 



I OFL 11 AO 


RETURN 



I OFL 1 150 


END 



l OFL l 160 



SUBROUTINE STRESS ( I PUNCH ) _ __ _ STRSQOJLO 

CALCULATE THE LOC AL NODAL OLSPLACENENT MATRIX ( D ISPLL )_, THE LOCAL STRS0020 
MEMBRANE STRESS MATRIX LSTRSLM), AND THE LOCAL BENDING STRESS STRS 0030 


c 

MATRIX 

(STRSLB) . 




STRS0040 

c 






STRS0050 


COMMON 

X ( 200) 

, Y ( 200) , l ( 200) , TH 

I 

200) 

* STRS0060 


1 

PRESSEI 200) 

. XL ( 200. 3) » YL_„ J_ 200j.3_)._i .. 



STRS0070 


2 

RAPANGI 100) 

, 2GL ( 100) t RHUB < 100) , RTIP 

I 

100) 

* STRS0080 


3 

THHUB ( 100) 

, THTIP « 100) , PRESSL ( 100.15) . EOCH 

J_ 

3,3) 

, SIRS 0090 


4 

RHO , OMEGA 

. POISSO . YOUNGS . RAOGEN , 



STRSdiOO 


5 

NGENLI » LINE1 , NPRESt 100) » NEXT (200.3) . NP 

*~NT 

* . 

STRSOllO 


6 

ELMSMI 6*6) , 

AMN INI 6. 6 ) , ELBSM ( 9.9 ) . ABNIN(9,9) 

.. f .... 


STRS0120 


7 

PFLGNI 9* I ) , 

CFLGNl 18.1) , ELSTIF ( 18,18) , ECSTIF(18, 

18) , 

STRSO i 30 


8 

PFCGNI 18*1)* 

CFCGN(lB.l). ME X (200, 8J » J MEX( 200) , 

FORCE! 

STRS0140 


_9 200*6 ) 

COMMON / TBAR / THBARI200) 

DIMEN SION E M I 3 * 3) * WM(3,6) PRST (15 ) _j 01 SPLL 

1 R 6( 18 *18) * Zl(3*9) , Z2 I 3 *9 ) _*JtND(6) * 

2 * VB(3* 3) * STRSL M ( 3 ) * STRSLB (3) J _EB(3t9 

3 C ( 3 ) * 0 1 SPL (18*200) _. ..... 

_ D ATA WH / l .Oi 4*0.0 *1 . 0, 2*0. 0 ,1. 0*0.0 ,1 .0.,._7*0.0 / 

DATA IND/ 1 * 2 ,7 * 8 * 13 * 14 / 

K1 = — A9 __ 

_ K 2 ■* 0 __ _ 

bo JL. I 4 - _ , -- . _ 

K1 = K1 + 50 __ _ _ 

„K2_^K2. +_50 ..... 

READ C3M) ■■((biSPL1JrK:)t.J"ltlB) .tKgKl.>K2) . . 

TERM * YOUNGS / ( 1.0 - P_0IS_S0**2 ) 


EMI 1* 1 ) - TERM 

EMI 1*2) = TERM * POISSO 
EMI 1*3) JL 0.0 „ ____ 

EM I 2jtl )„=_ EMJ l_t_2 ) 

EMI 2*2 ) a EMIlyj) 

EMI 2* 3 ) = 0.0 


EMI 2* 2) a EMI 1*1) 

EM I 2*3) = 0_._0 . _ _ 

„EMI3*AL = q.6 ___ . 

EM I 3* 2 ) = 0.6 

EMI 3* 3 ) J TERM * I 1.0 - POI SSO. ) / 2.0 

WRITE (6*5 ) _ _ 

FORMAT I 1H1 / 44X * 13HLQCAL SYSTEM / 35X*30H0EFL 

IPRI NTOUT ) _ „ . . 

_ KOUNT = -JL_ _ ... 

DO 65 I = 1* N T _ 

I PASS * 0 

SIGNS S = l._0_ _ _ _ _ 

READ 14*1) R6 , AMNIN , AB NIN ___ 

D O 1 0 J = 1 *18 _ _ . . . \_ _ _ .... . 

PI SPLL I J*l ) = 0.0 

_JD0_10 K = 1*1 8 

P I SPLL ( J , 1 ) = P I SPLL I J » i ) + R6IK, J ) * DISPLIK, I) 
KOUNT = KOUNT +1 


STRS0160 ... 

* PRST (15) _* Of SPLL 1 18*1) j_ STRSOITO 

) , 22(3,91 * I NO I 6 ) * BST I 3) * T ST I 3 ) ST R SO 1 80 
) * STRSLB 1 3) j_EB(3*9) ,A( 3J * B I 3 ) , STRS0190 
"7 _ _ STRS0200 

0 ,1. 0,6.0 ,1.6 »I_7*0 .0 / / STRS02LP. 

f 14 7 STRS0220_ 

J STRS0230 
“ " ~ - - - -j - STRS0240 

_ STRS0250 

STRS0260 

' ' "" STRS0270_ 

18) »k~Kl *K2) STRS_Q280_ 

S0^*2 ) “'2_ _ _ STRS0290 

STRS0300. 

_ „ STRS0310 

STRS0320 
STRS0330 
STRSp34p_ 
STRS0350 
STRS0360 

“ “ “ _ S T R S O 3 7 .0 

ssd ) / 2.0 ^ ' ST R SO 380 

_ _ STRS0390 

SYSTEM / 35X* 30 HDEFLECT I ON AND STRESS STRSO^OO 

STRS0410 


IF 

( 

KCUNT .EQ. 2 ) 

WRITE (6,5 

IF 

I 

KOUNT .EQ. 2 ) 

KOUNT = 0 

LA 

= 

NEXT (1*1) 


LB 

= 

NEXT! 1*2) 


LC 

_= 

NEXT (1,3) 



WRITE 1 6 , 15J _I * L A , X 1_L A ) ,_YJLA )„, U L_A) ,D IS PLL l_l.il > * P I S PL LI 2 * 1J, 
l 01 SPLL (3*1), LB, XI LB) ,Y(LB) ,Z I LB ) , DI SPLL (7,1), OISPLLI 8 , 1 ) * 


STRS0A20 

STRS0430 

STRS0431 

STRS0432 

strsoaVo 

STRS0450_ 

STRS0460 

ST RS 0470 

STRS0480 

STRS0490 

SJRS0500 

ST RS0510 

STRS0520 

STRS0530 

STRS0540 

ST RS 05 50 

STRS0560 
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2 DISPLLI 9,1), LC.X (LC),Y(LC),Z(LC) ,01 SPLL ( 13, 1) ,0! SPLL ( 14,1), STRS0570 

3 DISPLU 15,1) STRS0580 

FORMAT (// A 3X , 1 2HE LEMENT NO. I A /11X,72HN0DE X Y STRS0590 


I 

2MM0N 


COMMON 


COMMON 


H / 12X , 73HN0. C0STRS0600 
LOCAL LOCAL /STRS0610 


38X.2HLA, 15,3F10.3,3E15.5 / 8X, 2HLB ,15, 3F1 0. 3 , 3E1 5. 5 / 8X,2HLC,I5, STRS0620 


A3F 10. 3, 3E15.5 ) 


STRS0630 


00 20 J 

SB 

1 f 3 




STRS0640 

00 20 K 

* 

1*6 




STRS0650 

au,K) 

= 

0.0 




STRS0660 

DO 20 L 

= 

1*3 




STRS0670 

ZKJ»K) 

S 

Zl( J,K) 

+ EMIJ 

*L> 

* WM(L*K) 

STRS0680 

DO 30 J 

- 

1*3 




STRS0690 

CO 30 K 


1*6 




STRS0700 

Z2 ( J * K ) 

= 

0.0 




STRS0710 

DO 30 L 

X 

1.6 




STRS0720 

Z2< J*K) 

— 

Z2 ( J y K ) 

♦ 2 1 1 J 

*L) 

* AMN IN ( L * K ) 

STRS 07 30 

DO 40 J 

a 

1*3 




STRS0740 

STRSLM< J) 

= 0.0 




STRS0750 

DO 40 K 

a 

1*6 




STRS0760 

STRSLfM J ) 

= STRSLM(J) + 

12 i J 

* K ) * 01 SPLL ( I NO IK 1 * 1 ) 

STRS0770 


TERM1= YOUNGS * THBAR(l) / 2.0 / ( 1.0 - P01SS0**2 ) 


STRS0780 
STRS0790 
STRS0800 
STRS08 10 


-2.0 * TERM1 * (( 3.0 * ABNIN(6,1) ♦ POISSO * ABNIN(8,1) ) STRS0820 
* 0 1 SPLL ( 3,11 + POISSO * A8NINI 6,2) * DISPLLIA, 1) + ( 3.0 *STRS0830 
ABN IN ( 6 , 3 ) + POISSO * ABNINI 8, 3) » * 0.1 SPLL I 5, 1 1 + ( 3.0 * STRS08A0 
ABN IN ( 6 , A ) + POISSO * ABNINI 8, A) ) * DISPLL(9,l) + POISSO *STRS0850 
ABN IN ( 8 , 5 ) * 0 1 SPLL 1 1 0, 1 ) ♦ I 3.0 * ABNINI6.6) ♦ POISSO * STRS0860 
ABN I N ( 8 , 6 ) ) * 01 SPLL 111,1) + POISSO * A8NINI8.9) • STRS0870 
01 SPLL (17,1)) STRS0880 
-2.0 ♦ TERM1 * (( 3.0 * POISSO * ABNINI6.1) ♦ ABNIN(8,1) ) STRS0890 
A DISPLLI 3, l) + ABNINI 8,2 ) * OISPLUA,!) ♦ I 3.0 * POISSO *STRS0900 
ABNINI6.3) + ABNINI 8 , 3) ) * DISPLLI 5,1) + ( 3.0 * POISSO * STRS0910 


ABNINI 6, A ) + ABNINI 8, A) ) * 0ISPLLI9,!) + ABNINI8.5) 


STRS0920 


OISPLU 10,1) ♦ I 3.0 * POISSO * ABNINI 6,6) ♦ ABNIN(8,6) ) *STRS0930 
DISPLLI 11,1 J ♦ ABNINI 8,9) * 01 SPLL 1 17, 1 ) I STRS09A0 

2.0 * TERM 1 * I ABNINI 7,2 ) * OISPLUA, 1) ♦ ABNINI7.5) * STRS0950 
DISPLLI 10,1) ) * I 1.0 - POISSO ) STRS0960 
-2.0 * IERM1 * ( 3.0 * POISSO * ABNINI 9,1) * 0ISPLU3,t) + STRS0970 
I ABNINI 7,2) + 3.0 * POISSO * ABNINI9.2) ) * OISPLUA, 1) ♦ STRS0980 

3.0 * POISSO * ABNINI 9,3) * 01SPLL(5,1) + 3.0 * POISSO * STRS0990 
ABN IN I 9, A ) * CISPLL ( 9,1 ) + I ABNINI 7, 5) *■ 3.0 * POISSO * STRS1000 
ABN IN I 9, 5 ) ) * DISPLU 10, 1) + 3.0 * POISSO * ABNINI9.6I * STRS1010 
DISPLLI 11,1) + 3.0 * POISSO * A8NINI9.7) * OISPLU 15,. I 'I ♦ STRS1020 

3.0 * POISSO * ABNINI 9 , 8 ) * DISPLL(16,1) ) STRS1030 
-2.0 * TERM1* 1 3.0 * ABNIN(9,1) * 01 SPLL (3,1) + I POISSO *STRS10A0 
ABN INI 7,2) + 3.0 * ABNINI 9,2) ) * OISPLUA,!) + 3.0 * STRS1050 
ABNINI 9, 3) * D I SPLL (5,1) + 3.0 * ABNI N 1 9 , A) * D1SPLL(9,1) STRS1060 
+ ( POISSO * ABNINI 7, 5 ) + 3.0 * ABNINI9.5) ) * 01 SPLL 1 1 0 , l ) ST RS 1070 
♦ 3.0 * A BN I N 1 9,6) * OISPLU 11,1) + 3.0 * ABNINI9.7) * STRS1080 
OISPLU 15,1) ♦ 3.0 * ABN IN I 9, 8) * DtSPLL(16,ll I STRS1090 

2.0 * T f R M 1 * ( ABNI N I 8 , 1 ) * DISPLLI 3,1) ♦ ABNIN(8,2) * STRS1100 
OISPLUA,!) + ABNI N (8,3) * 01 SPLL. 1.5 ,1 ) + ABNINI 8, A) * STRS1110 
DISPLLI9, 1 ) «• ABNINI 8,5) * 01 SPLL I 10, 1) ♦ ABNIN(8,6) * STRS1120 
DISPLLI 11, 1 )♦ ABN IN I 8 , 9 ) * DI.SPLL (1 7, 1 > ) * I 1.0 - PCI SSO) STRS 1 130 
-2.0 * TERM1 * (I ABNINIA,!) + POISSO * A BN I N 1 5 , 1 ) ) * STRS11A0 
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noon o 


L D I S PLL (3,1) + POISSO * ABNIN(5,2) * P I SPLL I 4 , 1 ) + 

> I ABN I N( 4 » 3 ) + POISSO * ABNIN(5,3) ) * DISPLL(5,i) ♦ 

1 I ABN I N I 4 , 4 ) ♦ POISSO * ABN IN I 5 ,4 ) ) * DISPLL(9,1) ♦ 

^ I ABN I N I 4 * 6 ) + PUISSO * ABNIN(5,6) ) * DISPLLUi,l) ♦ 

> POISSO * ABN I N I 5 , 7 ) * DISPLL(15,1> ♦ POISSO * ABN IN! 5, 8 ) 

!> D I SPLL ( 16, 1 ) ♦ POISSO * ABNIN(5,9> * D I SPLL I i 7 , 1 ) ) 

C (2) = -2.0 * T ERM 1 *(( POISSO * ABN I N (4 , 1 ) + A8NI N ( 5,1) ) * 

l D I SPLL Ot l ) ♦ ABN INI 5*2) * DiSPLL(4,i) + I POISSO • 

l A BN IN ( 4 * 3 ) * ABN I N I 5 * 3 ) ) * DISPLL(5,1) + I POISSO * 

1 ABN IN (4* 4 1 ♦ ABN IN I 5,4) ) * OISPLL(9,l> + I POISSO * 

♦ ABN IN! 4, 6 ) f ABN IN I 5, 6 ) ) * OISPLLUl,!) ♦ ABNINI5.7) * 

> 0 ISPLL (15,1) + ABN I N ( 5 » 8 ) * DlSPLL(l6,i) + ABNINI5.9) * 

b D I 5 P L L 1 1 7 , l ) ) 

Cl 3) = 0.0 

XG - I XL (1,1) ♦ XL! 1,21 ♦ XL I 1,3) I / 3.0 

YG = I YLII.l) + YLI 1,2) + YLU,3) ) / 3.0 

00 50 K * 1,3 

BST(K) = I AIK ) *XG «■ B(K)*YG + CIK) ) * SIGNSS 


TST(K) = BSTIK) ♦ STRSLM I K ) 

TER Ml = ( 1ST I i ) + TST I 21 ) / 2.0 

TERM2 = SORT I I TST(l) - TSTI2) 1**2 / 4.0 ♦ TST(3)**2 I 
SIGNS = 1.0 

IF ( TST 1 2 ) .GT. TST(l) ) SIGNS = -1.0 
PRSTM ) = TERM! + SIGNS * TERM2 
PRSTI2) = TERM! - SIGNS * TERM 2 

PRSTI3) = 0.5 * ATANI 2.0 * TST 1 3 ) / I TST I 11 - TST (2 ) ) ) * 

1 57.29578 

PRSTI4) = I PRSTM) - PRSTI2) ) / 2.0 

PRSTI5) = SQRTI PRST(1)**2 - PRSTM) * PRSTI2) ♦ PRST<2)**2 ) 

IF I IPASS .EQ. 0 ) WRITE ( 6,55) I A I K ) ,B I K ) ,C I K) ,BST I K ) , K=i , 3 ) 
FORMAT I /20X , 74HBEN0 ING STRESSES * A * I LOCAL X VALUE ) ♦ B 

1 I LOCAL Y VALUE ) + C // 42X , 1HA , 1 4X , IHB , 14 X , 1HC , 7X , 1 7HVALUE / 

2 CENTRCID / 26X , 9HS I GMAXB AR , 4E15.5 / 26X , 9HS I GMA YBAR ,4E15.5 / 

3 26 X , 9hS HE AR .4E15.5) 

TERM1 = I BSTIl) + BSTI2) ) / 2.0 

TER M2 = SQRTI I BSTIl) - 8STI2) )**2 / 4.0 + BSTI3)**2 ) 

SIGNS = 1.0 

IF I BSTI2) .GT. BSTIl) ) SIGNS = -1.0 
PRSTI6) = TERM! + SIGNS * TERM2 
PRSTI7) = TERM1 - SIGNS * TERM2 

PRS T 1 8 ) = 0.5 * ATANI 2.0 * B5TI3) / I BSTIl.) - BSTI2) ) ) ♦ 

l 57.29578 

PRSTI9) = ( PRSTI6) - PR ST ( 7) ) / 2.0 

PRSTIIO) = SCRII PRS T 1 6 ) **2 - PRSTI6) * PRSTI7) + PKST(7)**2 ) 
TERM1 = ( STRSLM I 1 ) + STRSLM ( 2 ) ) / 2.0 

TERM2 = SORT! { STRSLM I 1 ) - STRSLMI2) )**2 / 4*0 > STRSLM(3)**2 ) 
SIGNS = i.O 

IF ( STR SLM 1 2 ) .GT. STRSLM! 1 ) ) SIGNS = -L.C 

PRS T 111) = TERM1 ♦ SIGNS * T ER M2 
PRSTI 12) = TFRMl - SIGNS * TERM 2 

PRSTU3) = 0.5 * ATANI 2.0 * STRSLM! 3 ) / I STRSLM(l) - STRSLM 1 2 ) 
l ) * 57.29578 


STRSLM I 2 ) 


PRSTI 14) = I PRSTM l ) 


PRSTI 12) ) / 2.0 
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PRST ( 15 > * SORT ( PRST (11 )**2 -_PRST( 11) * PRST ( 12) ♦ PRST (12) **2 ) STRS 1730 


1 ,15 ) , (BST (J) t j= 1 » 3 ) , (PRST1 J), J=6,_10)__, ( TSTJ J ) , J=1 , 3 ) , STRS1750 

2 (PRST(~J),J =1,5) _ ___ __ ” _ STRS1755 

60 FORMAT (/ 61X,3t * PRINCIPAL* 6X ), * MAXIMUM “ EFFECTIVE'' 7 STRS 1 760 

l 16_X_ 'SIGMAXBAR SIGMAYftAR SHEAR _ S IGMAXBAR STRS 1770 

2SIGMAYBAR TH E TA (DEG) SHEAR __ STRESS' / • MEMBRANESTRS 1780 

3 ' B E 15 . 5 7 « BEND. (TOP)' 8E15.5 / _• TOT ( TOP)' 8E1 5. 5 ) STRS1790 

I F ( IPASS . EQ. 1 ) WRITE (6,61) (BST ( J ) , J = l,3 ) , ( PRST( J ) » J=6 * 10 STRS1791 
1 ) . ( TST ( j),J= l ,3) , (PR ST ( j) , J -1 ,5 ) _ _ STRS 1792 

61 FO RMAT t _• BENO. (BOT) • 8E15.5 / • TOT. (BOT )• 8E15.5 //// j STRS 1793 

IPASS _= IPASS + l _ ’ ' STRS179A 

S1GNSS = -j.6 _ " ‘ ' ___ STRS1795 

IF ( IPAS S ,NE. 1 ) GO TO 65 STRS1796 

_ XG = ( XLI1.2I + XL (1,3) ) / 3.0 'JJ' STRS1797 

IF ( I PUNCH .NE. 0 ) WRITE (7,62) XL (1,2 ), X G, PRST(A), TST(l), STRS1798 

1 PRST ( 5 ) , PRST ( 10) , PRST (15) ' " ' STRS1799 

_62 FOR MAT ( 2Fi0.6, IP5E10.3 ) STRS179A 

GO TO 45 ___ " ' "" STRS179B 

65 CONTI NUE “ ' _ STRS1800 

RETURN _ "" _ STRS 18 10 

END ' ' _____ __ 11_Z_ 1 _ STRS 1820 
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CLOCK ST ART Q~ I CtOKOOOO 


BRO 

equ 

0 


CL0K0010 

BRl 

ECU 

1 


CLQK0021 

SR? 

“too 

“1 


CL0K0022 

BR3 

iqu 

3 


CL0K0023 

8R4 


4 


CLOKOQ24 

8R5 

cQU 

¥ 


CL0K0025 

SRS 

n-ou 



CL0K0026 

SR? 


i 


CL0K0027 

SRI 

EQU 



CL0K0028 

TR9 

eOu 

9 


CL0K0029 

BRIO 

EQV 

”10 


CL0K0030 

BRIT 

SOU 

11 


CL0K0031 

BR12 

w 

EuHHHHHHHHH 


CL0K0032 

HRT3 


13 


M'lVUlU— — 1 

SR1C 

EQU 

14 


CLGK0034 

BRIT 

1E0U 

13 


CLOK0035 


ENTRY 

MCLOCKy ICLOCKtSCLOCKf DATE 



USING * fBwlS 



H CLOCK SAVE 

<14,51* f * 


CL0K0100 


LR 

BR 1* BR13 _ 


CL0K0X03 


LA 

BR1 3» SAVE 


CimOTOB” 


snr 

BR13* 0»BR1 1 


6L OK 0107 ~ ” 


TT 

HNTy4<0yB8l3) 


CL0K0109 


TINE 



CL0K01I0 


1 

BRl 3 y 4 ( Q, SR 13 1 


CL0K0112 


t 

BR15, 16(0,BR13> 

“restore basemsister 

CLOK0115 


0 

tiftOyl^BYt 

INSU RE PROPER SIGN FO REPACKS 0 016177 

CL OK 01 20 


?r 

BRO,PTIME 

TEMP STORAGE FOR PACKEO TIRE. 

CL0K0130 


UNFIT - 

ZTIME17) tPTIMEUI 

“UNFACK TINFTO ZONED DECIMAL. 

CLOKO 140 


L 

BR3 f tl 1NE 

HOURS UNO MINUTES.” “ 

CLQK0130 


SLOL 

BR2.16 

“SHIFT IN 

CL0KOV6O 


5LL 

BR2 y 16 

HOURS WITH 

CLOkOHO 


0 

BR2tBLNK2 

TRAILING BUNKS. 

CLOKOIBO 


l 

BRl y26 { Oy SHiJF 


XCGK0T90 


L 

BRSfOlQfBRU 

ADDRESS OF FIRST PARAMETER. 

CL0K0200 


ST 

8RZ t 0(0rBR9l 

SAVE TINE. 

CL OK 02 10 


SL0L 

' 

s 

» 

IM 

ac 

99 

THTFT” IN 

CL0KD220 


SLi 

BR2 y 16 

MINUTES WITH 



0 

~SR2,BLNK2 

TRAILING BUNKS. 

CL0K0240 


L 

BRSyAiOyBft l | 


CL0K0243 


ST 

BR2»0(0,BR5 ) 

SAVE MINUTES. 

CL0K0250 


L 

»R3»Z JtrtE+A 

MINUTE AND TENTHS 
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SECTION IV 

VIBRATION COMPUTER PROGRAM (PWA 6140) 


A. GENERAL 

The vibration computer program is a finite element analysis which 
uses many of the same subroutines as the stress program. This program 
calculates natural frequencies and the distribution of relative 
displacement and stress for each resonant frequency. The resonant 
frequencies which satisfy the eigen-value equation: are obtained by 
reducing the term 



to an almost triangular Hessenburg form lH] by elementary similarity 
transformation. The eigen-values are then determined by an extension 
of Hyman* s method followed by iterations using a modification of 
Laguerre*s method. 

The size of the eigen-value subroutine limits the number of free 
finite element nodes to 50 (100 total nodes). The program requires 
210,000 bytes of core on the IBM System 360, Model 75 computer. Computer 
time for the full 50 nodes is approximately 3 minutes. Single precision 
with 4 bytes/word and 8 bits/byte is used. Fortran IV-G, Level 1, 

Mod. 3 compilations were used. 

B. INPUT DESCRIPTION 

The input to the vibration computer program generally consists of: 
a physical description of the inducer, a description of the finite 
element breakup to be used, and a specification of the number of 
vibratory nodes required. 

The finite element breakup should be sketched to aid in preparing 
the program input. An example is shown in figure 1. The program is 
limited to 50 free nodes (all nodes at the hub are fixed), 100 total 
nodes, and 100 triangular elements. 

The program will reproduce the required finite element breakup 
properly if the following rules are observed when preparing the input. 

1. If generator line <! i n has ,, ii ! * points and generator line 
"i+l" has "ii+l** points, then the lines forming the edges 
of the finite elements start at the first point of the 
generator with the least number of points and zig zag 
between the generator lines. The areas between generators 
A and B, B and C, D and E, etc., of figure 1 are examples. 

2. The area between the first two generator lines with the 
same number of points will be broken up as shown between 
generators F and G and G and H of figure 1. 
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3- The procedure of (2) will be followed for all generators 
with the same number of points until symmetry about a 
generator is requested, as was done about generator H 
in figure 1. 

4. The altered breakup will continue for sections between 
generators with the same number of points, until symmetry 
is again requested, as was done about generator J in 
figure 1. After symmetry is again requested, the breakup 
will revert to the original pattern. 

5. If two generators "i" and "j" have "m" and ,f n" points 
respectively such that 

m = 2 n-1 and n > 2 
or 

n = 2 m-1 and m > 2 

then the breakup will be as in the sections between L and 
It, and M and N of figure 1. 

6. Notice that generator A of figure 1 has only 
one point. In this case 

RHUB = RTIP and THHUB = THTIP 

7. Elements are identified as shown in figure 1 and nodes 
are identified as shown in figure 2. 

Unless otherwise specified, data may be input in any consistent 
set of units. The same units must be used for force and mass. Output 
will correspond to the input units used. Several examples are 
listed below: 


Input Output 


Force 

Mass 

Length 

Displacement 

Stress 

lb 

lb 

ft 

ft 

ib/ft 2 

lb 

lb 

in. 

in . 

lb /in . 

gram 

gram 

meter 

meter 

gram/meter 


Input data to be written on each card is described below. "F" 
format data should be left adjusted in the column field and should 
contain a decimal point. "E" format data (.300E08) must be right 
adjusted, "I" format data should not contain a decimal point and 
should be right adjusted. 

Card 1 Title Card 

As many title cards as required may be input. With a 1 in column 1 
the machine will read in another title card. Omit the 1 in column 1 on 
the last title card to stop the machine from reading title cards. 



Column 


Variable 


Format 


Card 2 

I- 10 RHO Density of the inducer blade (MASS= F10.0 

RHO/G) 

II- 20 POISSO Poisson's ratio for the material of the F10.0 

inducer blade. 

21-30 YOUNGS Youngs modulus of elasticity for the F10.0 

material of the inducer blade. 

31-40 RADGEN Generator line offset radius. R q in F10.0 

figure 3 . 

41-50 NGL Total number of input generator lines. HO 

Maximum of 50. 

51-60 NGS Number of generator lines about which HO 

geometric break-up symmetry is desired. 

61-65 MODE Total number of vibratory modes 15 

requested. Maximum is v the number of 
free nodes . 

66-70 I PRINT Intermediate print option which should 15 

be used for check-out of the program 
Leave blank for no intermediate print. 

Input as 1 (right adjusted with no 
decimal point) for the following 
intermediate print: 

a. Elemental local membrane stiffness matrices. 

b. Elemental local bending stiffness matrices. 

c. Elemental local membrane inertia matrices. 

d. Elemental local bending inertia matrices. 

e. Elemental local assembled stiffness matrices. 

f. Elemental local assembled inertia matrices. 

71-80 G Gravitational constant in the appropriate F10.0 

units. If left blank or input as 0.0, 
a value of 386.4 is used. MASS = RHO/G. 

Card 3 Symmetry Requests (Optional) 

1-5 NCHB(l) Generator line numbers of the generator lines 15 

6- 10 NCHB (NGS) about which geometric break-up symmetry is 

etc. desired. The only condition allowing this 

request for break-up symmetry is that the 
previous generator line and the next 
generator line must each have the same 
number of points as does the generator 
line about which symmetry is requested. 
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Column 


Variable 


Format 


That is 

NUP^i = NUP I = NUP 

Sixteen values per card, as many cards as 
needed. If NGS on line 3 was input as 
zero or left blank, omit this card(s). 

Card 4 Generator Lines (NGL Cards) 

I- 10 RAPANG(I) Wrap angle in degrees of the Ith F10.0 

generator line (0j , and 8 ^ in figure 
4) . No two adjacent wrap angles may 
be equal > All wrap angles must be 
either continually increasing or 
continually decreasing in size. 

II- 20 ZGL(I) z value a.t the hub of the Ith generator F10.0 

line. (zi and in figure 4). No two 
adjacent generator lines may have the 
same z value unless one of the two 
lean angles is non- zero. 

21-30 RHUB(I) If RADGEN ± 0, then RHUB(I) is the F10.0 

horizontal (x-y plane) distance from 
the point where the generator line 
is tangent to a cylinder with a 
radius of RADGEN to the hub of the Ith 
generator. 

If RADGEN = 0, then RHUB(I) is the 
radial distance from the z-axis to the 
hub of the Ith generator. 

3.1-40 RTIP(I) Measured the same as RHUB(I) except F10.0 

that it is the distance to the tip 
instead of the hub of the Ith generator. 

41-50 THHUB(I) Thickness of the inducer blade at the F10.0 

hub of the Ith generator line. 

51-60 THTIP(I) Thickness of the inducer blade at the F10.0 

tip of the Ith generator line. 

Thickness is varied linearly from the 
hub to the tip of a generator line. 
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Column 


Variable 

Format 

61-65 

NUP(I) 

Number of points on the Ith generator 
line which are used for the division 

15 



of the inducer blade into triangular 
elements. These points are evenly 
spaced between and including the hub 
and the tip. 


71-80 

ALE AN (I) 

The lean angle in degrees of the Ith 
generator line measured positive upward 
from the horizontal (x-y plane). These 
are illustrated by a in figure 3. 

F10.0 


C. OUTPUT DESCRIPTION 


X, Y, Z 
XL, YL 
TH 

FREQUENCY 

AMPLITUDE 

SIGMA X BAR, SIGMA Y BAR SHEAR 

PRINCIPAL SIGMA X BAR, PRINCIPAL 
SIGMA. Y BAR 

MAX SHEAR 
EFFECTIVE STRESS 


Common coordinates of vertices 
or nodes of triangular elements. 

Local coordinates of vertices 
or nodes of triangular elements. 

Nodal thickness of vertices of 
triangular elements. 

Natural frequency . 

Relative amplitude ratio of node. 

Relative bending stress of centroid 
of triangular element. 

Relative principle bending stresses 
at centroid of triangular element. 

Relative maximum shear stress at 
centroid of .triangular element 

Effective combined stress at 
centroid of triangular element. 


KM 


Triangular element local membrane 
stiffness matrix. 


KB 


Triangular element local bending 
stiffness matrix. 


MM 


Triangular element local mass 
matrix. 


MB 


Triangular element reduced mass 
matrix . 
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VIBRATION COMPUTER PROGRAM 
(Simulated Cantilevered Flat Plate) 


D. 
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RESULTING TRIANGULAR ELEMENTS 
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• 0.022 100. 750 3.250 0.1300 0.0 0.0 

• 0.022 101.000 0.250 3.1033 0.2533 0.0 

- 0.0 103.753 0.0 0.1333 - 3.0330 - 0.2510 

(CONTINUING TO ELEMENT NO. 6<t) 
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RELATIVE VIBRATORY BENDING STRESSES 
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f -4 

no 

f -4 




— 1 

f -4 

1-4 

1^ 

n- 

4 

in 

ro 

0 

O 

0 

O 

d 

O 

0 

0 

O 

0 

0 

0 

0 

0 

0 


I 


if i/mmt i/> ihir ip 


0 o 

in 


Hfu n ^ 
-n >c vO "O 


»— * t -4 O' —4 _4 00 —4 
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E, VIBRATION COMPUTER PROGRAM LISTING 



THIS IS THE MAIN PROGRAM FOR THE INDUCER VIBRATIONS PROGRAM 
DECK 6140 


MAINOOOl 

MAIN0002 

MAIN0003 


COMMON 

X ( 

100) 

, Y 

( 100) , Z 

( 100) 

9 TH 

( 100) 

, MA I N0004 

i 



XL ( 

100,3) , YL ( 

100,3) 

, 


MAI NOO 05 

2 

R APANG ( 

50) 

, ZGL 

( 50) , RHUB 

( 50 ) 

, RTIP 

( 50) 

, MAI NOO 06 

3 

THHUB ( 

50 ) 

, THTIP 

( 50) , 


EDCM 

( 3,3) 

, MA I NOO 07 

4 

RHO , 


POISSQ 

, YOUNGS , RADGEN , 



MA I NO 008 


NT 


10 


14 


N GENII , LINE! , NEXT I 100,3) , NP 

ELM SMI 6,6) , AMN IN ( 6, 6 ) , £LBSM(9,9) , ABN1N<9,9) , 

SIGMAX(lOp) , SIGMAYUOO) , EL ST IF ( 1 8, i 8 ) , 

TAUXYI 100), ELSSMI 9, 9 ) , , HEX (100 , 8 ) , IMEXUOO) , 

EL I NR I 18,18) , ELM I M { 6 , 6 ) , ELBIM(9,9) , ALE AN ( 50) 

DIMENSION I COL I 15) , ZCQS(lOO) , NUP(lOO) , NCHBI50) , IPOSUOO) 

DIMENSION OMEGA! 50 ) , IGENUOO) 

DATA I COL / 1 , 2 , 7 , 8 , 13 , 14 , 3 , 4 , 5 , 9 , 10 , 1 1 , 

1 15 , 16 , 17 / 

DEE INE F ILE l ( 100, 65 7, U , I R 1 ) , 2 ( 48 , 9 00 , U, I R2) , 3 ( 100 , 324 , U , I R3 ) 

CALL ZERO(X,ELBIM( 9,9) ) 

READ AND PRINT ALL INPUT 
CALL INPUT ( I PR IN T , NUP » NCHB ,MODE ) 

TRIANGULATION OF INDUCER BLADE AND DETERM INAT I ON OF THICKNESS AT 
EACH VERTEX . 

CALL GEOM ( NUP , NCHB , I POS , I GEN ) 

IF { ( NP .G T • 100 ) .OR. ( NT .GT. LOO ) ) GO TO 5 
DO 30 I * 1 , N T 
LA = NEXT ( I, 1 ) 

LB * NEXT! 1,2) 

LC = NEXH I, 3) 

IMEX(LA) = I ME X ( LA ) ♦ 1 
IMEXILB) = IMEX(LB) + 1 
IMEX (LC) = I MEXICO ♦ 1 
MEX (LA, IMEX(LA) ) = I 
MFXILB, IMEX(LB) ) = I 
MEX ( LC , l ME X ( LC ) ) = I 
CALCULATE THE DIRECTION COSINE MATRIX (EDCM ) FOR A TRIANGULAR ELEMMA I N0036 
CALL DIRCOS (LA,LB,LC,I) MAIN0037 

ZCOS(I) = EDCM (3,3) MAIN0038 

CALCULATE THE LOCAL COORDINATES ( XL , YL , ZL ) FOR A TRIANGULAR E LE MENMA I NCr 39 
CALL L COORD ( LA, LB ,LC , I ) 

CALCULATE THE MEMBRANE STIFFfv 
ELEMENT IN THE LOCAL CUOROIN/ 

CALL MEM ST F { L A , L B , LC , I ) 

CALCULATE THE BENDING STIFFNE 
ELEMENT IN THE LOCAL COORD I 
CALL BEN S T F ( LA, LB, LC, I ) 

IF ( I PR I NT • G E . 1 ) 
i WRITE 16,14) ( ( ELMSMt J,K) ,K=1, 6) , J = I ,6) , ( (ELBSM( J,K) ,K=1 ,9) , J*;i ,9) MAI N0048 

FORMAT ( IH1/45X,2HKM / 6 ( 1 OX , 6E 1 4 . 6/ ) //65X , 2HKB/9 ( 1X,9E14.6/)) 

CALCULATE THE LUCAL MEMBRANE INERTIA 
MATRIX ( ELM I M ) FOR A TRIANGULAR 


MAIN0009 
MAINOOiO 
MAINOOli 
MAIN0012 
MAI NOO 13 
MAIN0014 
MAI NOO 15 
MAIN0016 
MAI NOO 17 
MAIN0018 
MAIN0019 
MAIN0020 
MAIN0021 
MAIN0022 
MAIN0023 
MAIN0024 
MAIN0025 
MAT 0026 
MAI • >027 
MAIN0028 
MAI NOO 29 
MAIN0030 
MAIN0031 
MAIN0032 
MA I NOO 33 
MA I NOO 34 
MAIN0035 


MATRIX 

(ELMSM) FOR A TRIANGULAR 

MA 

MA 

SYSTEM 

( X L » Y L , Z L ) 

MA 



MA 

MATRI X 

(ELBSM) FOR A TRIANGULAR 

MA 

SYSTEM 

( XL , YL , ZL ) 

MA 



MA 

MA 


ELEMCNT. 


CALL 
IF ( 


t I NK 

(LA, LB, 

LC, I ) 


E THE LOCAL 

BENDING 

INERT 

AR F 

LEMF NT . 



1 1 NR 

(LA, LB, 

LC, I ) 


: INI 

.GE. I 

J WRITE ( 

6,15) 

( ( F L 

ft 1 M { J , K 

) ,K = l,9) , 

J=i, 9 


FUR A 


( ( E LMI M ( J ,K ) , K- 1 ,6) , J=l,6) , 


MAI NOO 49 
MAI NOO 50 
MA I NOO 5 l 
MA I NO 052 
MAIN0053 
MAI NOO 54 
MAI NO 05 5 
MAI NOO 5 6 
MAIN0057 
MA I NOO 58 


152 



rv o o o o o on 


15 


20 


2 A 


25 


26 


27 


30 


FORMAT ( // 4 5X » 2 HMM/6 { i OX , 6E 1 4 . 6/ ) / / 65X , 2HMB / 9 ( 1 X , 9E l 4. 6/ ) I MAIN0059 

ASSEMBLE LOCAL STIFFNESS MATRIX { EL ST I F ) AND LOCAL INERTIA MATRIX MAIN0060 


(ELINA) FOR A TRIANGULAR ELEMENT * 

DO 20 J = 1,6 
CO 20 K « 1,6 

EL I NR ( ! COL ( J ) » 1 COL IK) ) = ELMIM(J,K) 

EL ST I F { I COL ( j ) » I COL ( K) ) = ELMSMU.K) 

DO 24 J * 1,9 

DO 24 K - 1,9 

EL I NR ( I COL ( J +6 ) * I COL LK + 6 ) ) = ELBIMl J,K) 
EL ST I Ft I CUL ( J + 6 ) t I COL ( K + 6 ) ) = ELBSMI J,K) 
WRITE MM) ELSTIF, ELINR, FDCM 
IF ( IPRINT .GE. 1 ) WRITE (6,25) 


MAIN006I 
MAIN0062 
MAIN0063 
MAIN0064 
MAIN0065 
MAIN0066 
MAIN0067 
MAIN0068 
MAIN 00 69 
MAIN0070 
MAIN0071 


32 


FORMAT ( 1 H // 25X , 5 5H LOCAL COORDINATE SYSTEM TRIANGULAR ST I FFNESSMA I N0072 
1 MATRIX ) MAIN0073 

IF ( IPRINT .GE. I ) WRITE (6,26) ( ( EL ST I F ( J , K } , K = 1 , 1 8 ) , J- 1 , 1 8 ) MAIN0074 
FORMAT ( / / 1 8 ( 10E 12.4/8E 12.4/ ) ) MAIN0075 

IF ( IPRINT .GE. 1 ) WRITE (6,27) MAIN0076 

FORMAT I IH //25X , 52H LOCAL COORDINATE SYSTEM TRIANGULAR INERTIA MAMAIN0077 
1TRIX ) MAIN0078 

IF ( IPRINT .GE. 1 ) WRITE (6,26) ( ( EL INR ( J ,K) ,K = I , 1 8 ) , J= l , 18 ) MAIN0079 
CONTINUE MAIN0080 

PRINT GEOMETRIC BREAK-UP AND ASSOCIATED PROPERTIES . MAIN0081 

CALL PRINT l MAIN0082 

CALCULATE NORMAL DIRECTION COSINE MATRIX AT EACH NODE . MAIN0083 

CALL NORM ( ZCOS , I GEN ) MAIN0084 

TRANSFORM STIFFNESS MATRICES TO NORMAL SYSTEMS AND ASSEMBLE MAIN0085 

INTO A ( 3N X 3N) MATRIX . MAIN0086 

CALL ASSEMK ( ZCOS , IPOS ) MAIN0087 

TRANSFORM INERTIA MATRICES TO NORMAL SYSTEMS AND ASSEMBLE MAIN0088 

INTO A ( 3N X 3N) MATRIX . MAIN0089 

CALL ASS EMM ( ZCOS , IPOS ) MAIN0090 

REDUCE THE ASSEMBLED STIFFNESS MATRIX TO AN (N X N) MATRIX . MAIN0091 

N = NP - NGENLI MAIN0092 

CALL REDUCK ( N ) MAIN0093 

IF ( N *L.E. 0 ) GO TU 5 MAIN0094 

REDUCE THE ASSEMBLED INERTIA MATRIX TO AN (N X N) MATRIX . MAIN0095 

CALL REOUCM ( ,M ) MAIN0096 

IF ( N .LE. 0 ) GO TU 5 MAIN0097 

SOLVE FOR THE NATURAL FREQUENCIES . MAIN0098 

CALL EIGEN ( N, OMEGA ) MAIN0099 

SOLVE FOR THE AMPLITUDES FOR EACH REQUESTED FREQUENCY . MAI NO l 00 

DO 35 I = I, MODE MAINOIOI 

I F ( I .GT. N ) GO TO 5 MAI NO 102 

WRITE (6,32) l MAI NO 103 

FORMAT ( 1H1,//50X,22HAMPLITUDES FOR MUDE 13 ) MAIN0104 

M = NP - NGENL I MA I NO 105 



11 = N F 1 - 

I 

MA I NO 106 


CALL AMPL (M 

, OMEGA (III , IPOS) 

MAI NO 1 07 

3*) 

CALL STRESS l 

ZCUS, IPOS ) 

MA I NO 108 


GO TO 5 


MAI NO 109 

40 

STUP 


MAINOilO 


END 


MA I NO 1 1 1 


1 " 7 . 



SUBROUTINE INPUT ( I PR I NT , NUP , NCHB , MODE ) 
READ AND PRINT ALL INPUT 


INPUT001 

INPUT002 

INPUT003 


COMMON 

X ( 

100) 

» 

Y 

( 

100) , 

l ( 100) , 

IH 

( 100) 

, INPUT004 

i 




XL ( 

100,3) , 

YL ( 100,3) , 



INPUT005 

2 

RAPANGI 

60) 

t 

ZGL 

( 

50) , 

RHU8 ( 50) , 

RTIP 

( 50) 

, I NPUT006 

3 

THHUB ( 

50) 

t 

THTIP 

( 

50) , 


EOCM 

( 3,3) 

, INPUT007 

4 

RHO , 



POISSO 

» 

YOUNGS , RADGEN , 



I NPUT008 

5 

NGENL I , 

LINE i 

» 



NEXT ( 100,3) 

t NP , 

NT , 

INPUT009 

6 

CLMSM( 6, 

6) , 

AMN IN( 6, 

6) 

, ELBSM(9,9) , ABN IN (9,9) 

t 

INPUT010 


7 

10 

16 

20 


25 

26 

29 

30 


7 SIGMAX(IOO) , SI GMAY ( 1 00.1 , EL ST IF U 8, 1 8 ) , XNPUTOU 

8 T AU X Y { I 00 ) r EL SSM < 9, 9 ) f 'MF X { 1 00 , 8 ) , IMEXUOOV, INPUT012 

9 EL I NR (18 * i 8) , ELMIM(6,6) » .E-LB I M:( 9 *9 ) , ALE AN ( 50) INPUT013 

DIMENSION NUP (100) , NCHB(50) XNPUT014 

REAL TITLE (18) INPUT015 

WRITE (6,6) INPUT016 

FORMAT ( IH l / 38H0 INDUCER VIBRATION PROGRAM - DECK 6140 //) INPUT017 

CALL DATE (BMONTH, DAY , YEAR ) INPUT0I8 

WRITE (6,7) BMONTH, DAY, YEAR INPUT019 

FORMAT (6H0ATF ,A2, IH/,A2, 1H/,A2//) INPUT020 

READ ( 5, 15,END = 50) NT, TITLE INPUT02I 

FORMAT ( 11,1 8 A4 ) INPUT022 

WRITE (6,20) TITLE INPUT023 

FORMAT ( 5X , l 8A4 /) INPUT024 

IF ( NT .GT. 0 ) GO TO 10 INP0T025 

READ (6,25) RHU , PU I $ SU, YUUNGS, RADGEN , NGENL I , L I NE 1 , MODE , l PR I NT , G INPUT026 

FORMAT (2F10.0, E 1 0, 0 , F 1 0. 0, 2 I 10, 2 1 5 f F 1 0. 0 ) INPUT02 7 

) G = 386.4 

0 ) READ (5,26) ( NCHB ( I ) , I = L , L I NE 1 ) 


31 

32 

35 

39 

40 


IF ( G .EQ. 0.0 
IF ( LINEl .GT. 

FORMAT ( 1615) 

CO 29 I = 1,50 

IF ( NCHB(I) .GT. 0 ) GO TO 29 
NCHB ( I ) = NGENL I ♦ l 
CONTINUF 

WRITE (6,30) RHO » G» PO I SSO , YOUNGS , NGENL I , LINEl , RADGEN, MODE 

FORMAT (//10X, 10HDENSITY = F6.4,5X,4HG = ,612.4, 5X, 

1 1 8HP0 I S SON 1 S RATIO = F 5 . 3 , 5 X , i 8HYCUNG • S MODULUS - E12.4 //lOX, 

2 26HN0. UF GENERATING LINES = 14,5X,40HN0. OF SYMMETRY CHANGES RFQI NPUT03 7 

3UESTEC = 13 // 10X , 3 1HGENER A TUR LINE OFFSET RADIUS = F9.3 // INPUT038 

4 10X,24Hf\IO. OF MODES REQUESTED - 14//) INPUT039 

IF ( LINEl . EQ. 0 ) GU TO 32 
WRITE (6,31) ( WC H H ( I ), 1=1, LINED 

FORMAT ( IOX, 38HSYMMETRY CHANGE ABOUT GENERATOR LINES 1515/) 

KOUNT * 0 
RHO = RHU / G 
WRITE (6,5) 

00 45 I = 1, NGENL I 

RE AC ( 6, 35 ) RAPANG* I ) , ZGL ( I ) , KHU8 ( l ) ,RTIP( I ) , THHUB ( I ) , THTI P ( I ) , 

1 NUP ( I ) , ALE AN ( I ) 

FORMA I ( 6F l 0.0, I 5, 5X , F l 0.0 ) 

WRITE (6,39) 1 

FORMAT ( 30X, 22HGCNFRAT0R LINE NUMBER I 3 , 5 X , 16H { ANGLES IN DEG.) /) INPUT051 
wR I TE (6,40) RAPANGt I ) , ZGl ( I ) ,RHUR( I ) , RT I P ( I ) , THHUB ( l ) , THT IP ( I ), INPUT052 
l ALE ANT I ) , NUP(I) INPUT053 

FORMAT ( . I 0 X , 1 3H WK A P ANGLF = F 12 . 6 I NPU T054 

1 , 6 X : , 7HZHU6 = F fc . 4 , 5X , i 3HHU3 RADIUS = F 8 . 4 , 5 X , 1 3HT I P RADIUS INPUT055 

2= F 8 . 4 / 6 X , l 6 HHU B THICKNESS - F 7 . 4 , 5X , 16HT IP THICKNESS = F7.4,5X, INPUT056 

3 1 2 HL F A 4 ANGLE = F12.6, 5X, 16HNQ. OF POINTS = 12/) INPUT057 


INPUT028 
INPUTD29 
X NPUT030 
INPUT 031 
INPUT032 
I NPUT033 
I NPUT034 
INPUT035 
INPUT036 


INPUT040 
INPUT041 
INPUT042 
INPUT043 
INPUT044 
INPUT045 
INPUT046 
INPUT 047 
INPUT048 
INPUT049 
INPUT050 


154 


\ 



KOUNT = KOUNT + l 

IF (KOUNT .FQ.il) fcRITE (6,5) 

if < kuun r .ec. in kount = o 

ALEAN(l) = ALEAMd) * 0.0174533 
45 RAPANG ( 1 ) = RAPANGI I ) * 0.0174533 
GO TO 55 
50 STOP 
55 RETURN 
ENO 


l NPUT058 
INPUT059 
INPUT060 
I NPUT06 1 
I MPUT062 
INPUT063 
INPUT064 
INPUT065 
I NPUT066 
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CV o o 


SUBROUTINE GEOM { NUPfNCHB, IPOS/IGEN ) 

TRIANGULATION UF INDUCER BLADE AND DETERMINATION OF THICKNESS AT 
EACH VERTEX AND PRESSURE UN EACH TRIANGLE . 


GEOMOOIO 

GEOMO020 

GEOMOOIO 

GEOM0040 


COMMON 

X t 

LOO) 

* 

Y 

t 100) 

• i i loo) * 

TH 

! TOO) 

, GEOM0050 

1 




XL ( 

o 

o 

OJ 

, YL I 100,3) , 



GEOMOO 60 

2 

RAPANG! 

50) 

t 

ZGL 

< 50) 

, RHUB { 50) , 

RTIP 

! 50) 

, GEOM 0070 

3 

THMUB ! 

50 ) 

t 

THT IP 

! 50) 

» 

EDCM 

< 3,3) 

, GEO MOO 80 

4 

RHO , 



PUISSO 

* YOUNGS , RADGEN , 



GEOM0090 

5 

NGENLI , 

L I NE i 

» 


NEXT I 100,3) 

t NP , 

NT * 

GE0M0100 

6 

ELMSMT6, 

6) , 

AMN I N (6 » 

6) , E LBSM ( 9 , 9.1 , ABMN<9,9> 

, 

GEOMOl 10 


7 SiGMAX(IOO) , SIGMAYUOO) , EL ST IF ! 1 8 , 1 8 ) , 

3 TAUXYI 100 )* ELSSMI 9 , 9 ), MEXU 0 G. 8 ), IMEXUOO) , 

? EL I NR I 18* 18 ) , ELMIMC6.6) , ELBIM(9,9) , ALE AN ( 50 ) 

DIMENSION N U P ( 10 0) , NCHBI50) , I POST 100) , I GEN ( 100) 

ICHB = L 
KOUNT = -i 
IPOS! 1 ) = ~ 1 
NPl = I 
NT = 0 
NP = NUP! 1 ) 

NS = NGENLI - L 
DO 90 I = l, NS 
NT 1 = NUP1I) + NUP! I +1 ) -2 
IF { I .NE. I ) GO TO 15 
L INE = NUP ( I ) 

DR = 1.0 

IF ! LINE .EQ. I ) GO TO 1 

DR * I RTIPII) - R HUB ( I ) ) / FLOAT! LINE - i ) 

RADIUS = RHUB! I) - DR 
SINA = SIN! RAPANG! I ) ) 

COSA = COS! RAPANG! I ) ) 

TANL » TAN ( ALE AN! I) ) 

DO 10 J = l . L INE 
IF ( J ... E Q • l ) oO TO 5 
KOUNT = KOUNT + 1 
I POST J ) = KOUNT 


FLOAT! LINE - 


RADIUS 
Z ( J ) 

X! J ) 
Y!J) 
THU) 


RADIUS + DR 

ZGL! I ) ♦ ( RADIUS - RHUB! I ) ) * ' 

RADGEiM * COSA - RADIUS * SINA 
RADGCN * SINA + RADIUS * COSA 
THHU8 < I ) + ! THTIPtli - THHUBII) 

/ ( R T I P ( I ) - RHUB! I ) ) 


< RADIUS - RHUB! I) 


L / ( R T I P ! I ) - RHUB! I ) ) 

I GEN ( J ) = I 

IF { THU) .LT. 0.0 ) TH{J) = 0.0 

CONTINUE 

L INF = NUP! 1+1) 

CR = 1.0 

IF ( LINE .ED. i ) GO TU 16 

DR = ! R T I P ( 1 + l ) - RHUB! l+l ) ) / F 

RADIUS = RHUB t I + L > - DR 

J2 = NP + 1 

J 3 = NP + NUP 1 .1 + l ) 

I PU S ! J 2 ) = -'1 

SINA = SIN! RAPANG! I +1) ) 

COSA = CUSt RAPA1G! l + l ) ) 

TANL = IASI! AL FAN t I + 1 ) ) 


FLOAT! LINE - 


GEOMOl 20 
GE0M0130 
GEOMOl 40 
GE0M0150 
GEOMOl 60 
GE0M01 70 
GE0M0180 
GEOMOl 90 
GE0M02 00 
GE0M02 10 
GE 0M0220 
GEOM0230 
GE0M0240 
GEOM0250 
GEOM0260 
GE0M02 61 
GE0M0262 
GE0M0270 
GE0M0280 
GEQM0290 
GE0M0300 
GF0M03 10 
GEOM0320 
GEOM0330 
GE0M0340 
GEOM03 50 
GEQM0360 
GE0M03 70 
GE0M0380 
GE0M0390 
GE0M0400 
) GE0M04 10 
GE0M0420 
GE0M0421 
GEOM 04 30 
GE0M0440 
GE0M0441 
GE0M0442 
GEOM0443 
GE0M0450 
GE0M0460 
GEOM04 70 
GE0M0480 
GEOM0490 
GE0M0500 
GEOMOSLO 
GEOM0520 
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o o 


00 25 J * J2,J3 

IF ( J ♦ EQ • J2 ) GO TO 20 
KtJUNT = KO.UNT > i 

1 POS I J 1 :S KOUN T 

20 RADIUS = RADIUS ♦ DR 

Z(J) * Z.GLM + l) ♦ ( RADIUS - RHUBtl + I) I * TANL 
X C J I = RADGEN * COSA - RADIUS * SINA 
YU) * RADGEN * SINA ♦ RADIUS * COSA 

TH(J)* THHUBM+U + ( THT IP( IH) - THHUBtI+1) ) * ( RADIUS - 
i RHUBI I ♦ l ) ) / ( RTIPU + l) - RHUBU + l) ) 

I GENU ) * I > 1 

IF ( THU) .LT. 0.0 ) THU) = 0.0 
25 CONTINUE 

Jl * NT ♦ i 
J 2 * NT + NT l 
NB * 0 
K = 0 
NB 1 = “2 
NPT1 = NUP ( I ) 

NPT2 * NUP (1+1) 


IF 

(NPT1 

.EQ. 

NPT2 ) 

GO 

TO 

27 


IF 

(NPT2 

- HPT 

1 

.eg. 

1) 

GO 

TO 

275 

IF 

(NPTi 

- NP T 

2 

.EQ. 

l) 

GO 

TO 

270 

IF 

(NPT2 

- NPT 

1 

.GT. 

1) 

GO 

TO 

265 


C BOTTOM GENERATOR HAS AT LEAST TWO MORE NODES THAN THE TOP 

C GENERATOR. 

DO 2.6* J * Jit J2 
K * K + l 
L = MODI K, 3 ) 

IF U .EQ. 0) L = 

GO TO (261, 262, 263), L 

261 NBl = NB 1 + 2 

NEXT ( J *1 ) * NP1 + NB 1 
NEXT (J, 2) = NP1 + NB 1 ♦ 1 
NEX T < J , 3 ) = NP + NB l / 2 > 1 
GO TO 264 

262 NFXTU.l) = NEXTU-1,3) 

NEXT U, 2) = N E X T U » 1) > 1 
NEXTU/V) = .NEXT (J-1, 2) 

GO TO 264 

263 NEXTUtl) = NtXTU-1,3) 

NEXT (J , 2 ) * NEXT U , 1 ) + 1 
NEX T U » 3 ) * NEXT (J-1, 2) 

264 CONTINUE 
GO TO 86 

TOP GENERATOR HAS AT LEAST TWO MORE NODES THAN 
THF BUT! OM GENERATUR. 

265 DO 269 J = Jl, J2 
K = K > i 
L = MOC { K , 3 ) 

IF (L .EQ. 0) L = 3 
GO TO (266, 267,268), L 

266 NBl = NrH + 2 
NFXTUtl) * NP + NBl + l 
NFX T ( J , 2 ) * NP + rlHl ♦ 2 
NE X T ( J , 3 ) = NPl + NB l / 2 
GO TO 269 

26/ NEXT (J » l ) = NC XT (J-1, .-3) 


GE0M0530 
GE0M0540 
GE0M0550 
GEOM0560 
GE0M05 70 
GEOM0580 
GEOM0590 
GEOM0600 
GEQM061 0 
GEOM0620 
GE0M062 1 
GEOM0630 
GE0M0640 
GEQM0650 
GE0M0660 
GEQM0670 
GEOM067 1 
GE0M06 72 
GEQM0673 
GEOM0674 
GEOM0675 
GE0M0676 
GEOM0677 
GEQM0678 
GE0M06 79 
GE0M0680 
GEQM068 1 
GEOM0682 
GE0M0683 
GE0M0684 
GEOM0685 
GEOM0686 
G60M068 7 
GEQM0688 
GE0M0689 
GEOM0690 
GE0M069 1 
GEOM0692 
GE0M069 3 
GEOM0694 
GE0M0695 
GE0M0696 
GE0M0697 
GEOM0698 
GE0M0699 
GEQM0700 
GE0M070 i 
GEOM0702 
GE0M0703 
GE0M0704 
GE0M0705 
GEOM0706 
GEOMO70 7 
GE0M0708 
GEOM0709 
GEUM07 10 
GE0M0711 
GEOM07 12 
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NEXT * J , 2 ) = NFX T ( J , l ) ♦ 1 
NEXT t J 1 3 ) * NEXTU-1 V 2) 

GO TO 269 

268 NFXT* J, l ) = NEX T * J- i » 3 ) 

NEXT* J,2 > = NEXT* J, l ) + 1 
NEXT* J, i) = NEXT* J-1,2) 

269 CONTINUE 
GO TO 85 

C BOTTOM GENERATOR HAS ONE MORE NODE THAN THE TOP GENERATOR. 

270 NEXT * J l , l ) = NP1 
NEXT ( J 1 » 2 ) = NP1 ♦ 1 
NEXT* J l, 3) = NP ♦ i 

IE (J1 .EQ. J 2 ) GO TO 85 

J 1 1 - JI ♦ 1 

DO 271 J = Jll,J2 

NEX T ( J , l ) = NEXT * J - 1 * 3 ) 

NEXT* J, 2) * NEXT * J » 1 ) ♦ 1 
271 NEXT ( J * 3 ) = NFXT*J-1,2) 

GO TO 85 

C TOP GENERATOR HAS ONE MORE NODE THAN THE BOTTOM GENERATOR. 

275 NEXT* Jl, 1 ) - NP ♦ l 
NEXT * J 1 , 2 ) * N P ♦ 2 
NEXT * J L , 3 ) = NP l 

IE C J l .EG. J 2 ) GO TO 85 
Jli = Jl * 1 
00 276 J = Jli, J2 
NEXT * J , 1 ) = NEXT* J- 1, 3) 

NEXT* J,2 ) = NEXT* J, 1 ) + 1 

276 NE X T * J , 3 ) = NEXT*J-1.«2) 

GO TO 85 

C SAME NUMBER UF NOOES ON TOP AND BOTTOM GENERATORS . 

27 IF * RAOGEN .NE. 0.0 ) GO TO 55 

IE ( NCHBUCHB) .EQ. I ) GO TO 40 
IF * ICHB .GE. 2 ) GO TO 4? 

2 8 CO 35 J « J l , J 2 

K * J - J l + 1 

IE * MOD * K , 2 ) .EQ. 0 ) GO TO 30 

NB = NB ♦ 1 

NEXT* J,i ) * NP ♦ NB 

NEXT* J, 2 I MP MM 1 

NEXT* J, 3 ) a NP 1 *■ NB - 1 

GO TO 35 

30 NEXT* J,1 ) = NP1 ♦ NB - I 
NEXT* J,? ) = N.P1 ♦ NB 
NEXT* J, 3) = NP + NB ♦ 1 
35 CONTINUE 
GO TO 85 

40 ICHB = ICHB ♦ l 

42 If * MOD* ICHB, 2) .EQ. 1 ) GO TU 28 
DO 50 J = J 1 , J 2 

K a J - J 1 * 1 

IF * M, 0 0 * K i 2 ) .EQ. 0 ) GO T r i 45 
NB = NB + 1 

NEXT* J,1 ) = NP i ♦ Nb ■- 1 
NEXT* J, 2) ■= NP i + NB 
NEXT* J, 3 ) = NP + MB 
GO TU 50 

45 NEXT* J, U = NP ♦ NB 


GEOM0713 
GE0M0714 
GE0M0715 
GE0M0716 
GEOM0717 
GE0M07 1 8 
GE0M0719 
GE0M07 20 
GEOM072 1 
GE0M0722 
GEOM0723 
GE0M0724 
GE0M0725 
GE0M0726 
GEOM0727 
GEOM0728 
GEOM0729 
GE0M0730 
GE0M0731 
GE0M0732 
GEUM0733 
GE0M0734 
GE0M0735 
GEOM0736 
GEOM0737 
GE0M0738 
GE0M07 39 
GEOM0740 
GEOM0741 
GEOM0742 
GE0M0743 
GE0M07 44 
GE0M0745 
GE0M0746 
GE0M0747 
GEOM0748 
GEQM0749 
GE0M075O 
GE0M075 i 
GEOM0760 
GEOM0770 
GEOM0780 
GEOM0790 
GEOM0800 
GEOM08 10 
GE0M0820 
GEOM0R30 
GEOM08 40 
GFOM0850 
GEOM0860 
GE0M0870 
GE0M0880 
GEOM0890 
GE0M0900 
GE0M0910 
GE0M0920 
GEOM0930 
GEOM0940 
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N E X T ( J , 2 ) NP + M8 + 

1 

GE0M0950 


N E X T ( J , 3 ) = NP 1 * Nb 


GEOM0960 

>0 

continue 


GEGM0970 


GO TO 86 


GE0M0980 

55 

If t NCHBUCHB) .80. I 

) GO TO 70 

GE0M0990 


IF ( ICHti .GC. 2 ) GU 

TO 72 

GEOMlOiO 

58 

Of) 65 J * Ji , J2 


GEOM1020 


K = J - J1 + l 


GE0M1030 


If ( MOOT K 1 2 ) . 80. 0 ) 

GO TO 60 

GEOM 1040 


NB = NB + 1 


GEOM1050 


N F X T ( J » 1 ) * NPl + Nb - 

1 

GEOM 1060 


NEXT! J, 2) = NP l ♦ NB 


GE0M10 70 


NEXT <J f 31 = NP + NB 


GE0M1080 


GO TO 65 


GEQM1090 

60 

NEXTt J,l) = NP + NB 


GEOMilOO 


NEXT ( J » 2 ) = NP ♦ NB ♦ 

l 

GEOMlllO 


NEXT U, 3) = NP l + NB 


GEOM 1 1 20 

65 

CONTINUE 


GEOM1130 


GO To 85 


GEOM 1 1 40 

70 

ICHB = ICHB + i 


GE0M1150 

n 

IF ( MODI ICHB, 2) .EQ. 

i ) GO TO 58 

G80M1160 


DO 80 J = J 1 , J 2 


GEOM 1170 


K - J - J i ♦ 1 


GEOM 1180 


IF ( MOD ( K , 2 ) .EU. 0 I 

GO TO 75 

GE0M1190 


NB = NB ♦ I 


GEOM 1200 


NEXT! J, 1 ) = NP ♦ NB 


GEOM 12 10 


NEXT! J, 2 ) * NP + NB + 

i 

GEOM 12 20 


NEXT I J, 3) = NP L ♦ NB - 

1 

GE0M12 30 


GO TO 80 


GEOM 1240 

75 

NEXT! J, I ) = NPi ♦ NB - 

1 

GEOM 1250 


NEXT 1 J , 2 ) = NP 1 * NB 


GE0M1260 


NEXT (J, 3) = NP + NB ♦ 

1 

GE0M1270 

80 

CONTINUE 


GEOM1280 

d5 

CONTINUE 


GEOM 1290 


NP l = NP + l 


GEOM l 300 


NP = NP ♦ NUP ( 1 + 1 ) 


GEOM1310 


NT = NT + NT 1 


GEOM 13 20 


IF { NP *L 8 • 100 ) GC 

TO 87 

GEOM 1 3 30 


WRITE (6,86) 


GEOM 1 340 

86 

FORMAT ( / / 20X , 35HM0R E 

THAN 100 POINTS WERE GENERATED ) 

GEQM1350 


RETURN 


GEOM 1360 

8 7 

IF { NT .LE. 100 ) GU 

TO 90 

GEOM 13 70 


WRITE (6,88) 


GEOM 1380 

88 

FORMAT ( / / 20 X , 3 7HM0R E 

THAN 100 ELEMFNTS WERE GENERATED ) 

GEOM 13 90 


RETURN 


GEOM 14 00 

00 

CONTINUE 


GEOM 1410 


NP1 = NP - NGENLI 


GEOM 1411 


IF ( NP l .LE. 80 ) GU 

TO 100 

GE0M1412 


NP = 150 


GEOM 14 13 


WRITE (6,95) 


GEOM 14 14 

95 

FORMAT ( //20X, 38HMURE 

THAN 50 FREE NUDES WERE GENERATED ) 

GEOM 14 15 

1 00 

RETURN 


GE0M1420 


FNC 


GEOM 14 30 
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o u o 


Y { 
XL < 1 
ZGL < 
THTIP ( 
PUISSO 


{ 100) , Z (100) 

( 100,3) , YL ( 100,3) 

( 50) , RHU6 ( 50) 

P ( 50) , 

$0 , YOUNGS , RADGE N , 

NEXT ( 100,3) 


SUBROUTINE UIRC05 <LA,LB,LC,I> CIRC0S01 

CALCULATE THE DIRECTION COSINE MATRIX ( E DC M ) OF ELEMENT LOCAL AXESDI RC0502 
( XL , YL ,7.1 ) P FI AT I V F TO COMMON AXES (X,Y,Z) . DIRC0S03 

0IRCGS04 

COMMUN X i 100) , Y { 100) , Z (100) i'H ( 100) ,0IRC0S05 

L XL 1 100,3) , YL (100,3) OIRCOS06 

2 RAP ANG ( 50) , ZGL ( 50) , RHUB ( 50) ♦ .RTtP ( 5.01 ,0IRC0S07 

3 THHUB ( 50) , THTIP { 50) , EOCM ( 3,3) ,DIRCOS08 

^ RHG , PUISSO , YOUNGS , RADGEN , 0IRCOS09 

5 NGENLl , LINE l , NEXT ( 100,3) , NP , NT DIRCOSiO 

DOUBLE PRECISION L 12 , SIX , SlY , S1Z , SI , S2 X , S2Y , S2Z , DIRCOSH 
1 S2 % /0IR.C.0.S12 

L 1 2 - SORT ( (X(LB)-X(LA) )■*■■*. 2 + ( Y ( LB ) - Y ( LA ) > **2 + ( Z ( LB ) -Z ( L A ) ) **2 ) 01 RCOSL 3 
SIX - (Y (Lb) -YU A) ) * (Z(LC)-Z(LA) ) - ( YT LC J- Y( L A > ) * { Z { LB ) -Z ( L A ) ) DIRC0S14 
SlY = (Z (LB)-Z(LA) >*(X<LC)-X(LA) ) - ( ZTLC l-Z ( L A) ) * ( XT LB) -X (LA) ) DIRC0S15 


DOUBLE PRECISION L 12 , SIX , SlY , S1Z 


( X { L B ) - X ( LA) ) * ( Y ( LC) - VILA)) 
(Y(LB) - VILA)) 

1 .0 

C .LT. LB ) SIGN = -1.0 


X ( L A ) ) * 


SIGN ** ).0 
If ( LC .LT. LB ) 
SIX = SIX * SIGN 
SlY = SlY * SIGN 
SIZ = SIZ * SIGN 
SI =DSQKT( SI. -'*2 
S2X = SlY * ( Z I L B ) 
S2Y = SIZ * (XT LB) 
S2Z = SIX * ( Y ( LB) 


*2 > SlY** 2 ♦ SI Z**2 ) 

B ) - ZT LA ) ) - SIZ * LY(LB) - Y (LA) ) 

B) - X ( L A ) ) - SIX * ( Z ('LB') - Z ( L A ) ) 

ft) - Y ( LA)) - SlY * ( X ( LB ) - X(LA)) 


S2 sCSO'RTT S2X**2 + S2Y**2 + S2Z**2 ) 
EOCM (1,1 ) = ( X ( L 8 ) - XT L A ) ) / L12 


EDCM( 2,1 ) 
EDCMI 3,1 ) 
EOCM (1,2) 
FDCM (2,2) 
EOC M ( 3,2 ) 
EDCMI 1,3) 
EOCM (2,3) 
EDCMI 3, 3 ) 
RETURN 
END 


I Y ( LB ) - Y ( L A ) ) / LI 2 

( ZILB) - Z (LA ) ) / L 1 2 

S2X / S2 

S2Y / S2 

S2Z / S2 

SIX / Si 

SlY i Si 

SIZ / Si 


DIRC0S16 
0IRC0S17 
DIRC0S18 
0IRC0S19 
DIRCGS20 
DIRC0S21 
01 RC OS 22 
D IRC OS 23 
DIRC0S24 
0IRC0S25 
0IRC0S26 
0IRC0S27 
DIRC0S28 
DIRC0S29 
0 IRC OS 30 
0IRC0S31 
DIRC0S32 
OIRCOS33 
D IRC OS 34 
0IRC0S35 
0IRC0S36 
DIRCOS37 
0IRC0S38 
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cv m sH 


C 

c 

c 


SUBROUTINE LCOORO (LA, 

LB 

t LC , 

I > 






LCQORDO l 

PETERS I ML LOCAL NODAL 

COORDINATES (XL 

* 

YL,ZL) 

OF TRIANGULAR 

ELEMENTLC00RD02 

FROM COMMON NODAL COORDINATES 

C X , Y , l ) 


• 



LC00R003 










LCOORDOA 

COMMON X ( 100) , 

Y 


t 

100) , 

Z 

( 

100) , TH 

t 100) 

, LC00RD05 


XL 

( 

100,3) , 

YL ( 100,3) , 


LC00RD06 

RAP ANG( 50) , 

ZGL 

( 

50) , 

RHUB ( 

50) , RTIP 

( 50) 

, LCC0R007 

THHUB t 50) , 

THTIP 

{ 

50) , 



EDCM 

t 3,3) 

, LC00RD08 

RHO , 

POISSO 

* 

YOUNGS 


RADCEN , 


LCOORD09 

■ NGENLI , LINE! 

* 




NEXT < 

100,3) , NP , 

NT 

LCOOROIO 

X L ( 1,2)= EDCMt 1,1) * ( 

xt 

LB) 

- 

Xt LA ) ) 

♦ 

EDCMt 

2,1) * C Vi LB ) 

- Y ( LA ) 

) LCOORD 1 1 

♦EDCMt 3 , 1 ) * ( 

zt 

LB") 

- 

Z t L A ) ) 





LC00RD12 

XL ( 1 , 3 )= EDCM t 1,1) * ( 

xt 

LC) 

- 

X ( L A ) ) 

♦ 

EDCMt 

2,1) * ( VI LC 1 

- Y ( LA ) 

) LCOORO l 3 

♦E0CM(3,i) * ( 

Zt 

LC ) 

- 

Zt LA ) ) 





LCCORD 14 

YU I , 3 ) = EDCMt 1,2 ) * t 

Xt 

LC) 

- 

X t L A ) ) 

+ 

EDCMt 

2,2) * ( Y t LC ) 

- Y t LA ) 

) LCOORD 15 

♦EDCMt 3, 2) * t 

Zt 

LC) 

- 

Zt LA) ) 





LCOORO 16 

RETURN 









LCOORD 1 7 

END 









LCG0RD1 8 



CNi CO U"\ >0 


SUBROUTINE ME MS Tf ( LAA,LBB,LCC, IE ) 

CALCULATE THE LOCAL MEMBRANE STIFFNESS MATRIX (ELMSM) FOR A 
TRIANGULAR EL EM FN F . 

CUMMON X ( 100) , Y ( 100) , Z ( 100) , TH ( 


MEMSTIOl 

MEMSTI02 

MFMSTI03 

MEMSTI04 


X ( 100) 

, 

Y 

( 100) , l 

( 100) , 

TH 

( 100) 

,MEMSTI05 



XLL ( 

100,3) , YLL ( 

100,3) f 



MEMSTI 06 

RAPANGt 50) 

, 

ZGL 

( 50) , RHU8 

( 50) , 

RTIP 

t 50) 

, ME MST I 07 

THHUB t 50) 

, 

THT IP 

t 50) , 


EDCM 

( 3,3) 

.MEMST 108 

RHO , 


PUISSG 

, YUUNGS , RADGEN , 



MEMST 109 

NGENLI , LINE! 

, 

NEXT ( 

100, 3) 

♦ NP , 

NT , 

MEMSTI 10 

ELMSM ( 6,6 ) , 

AMNINt 6, 

6) , ELB SM (9,9) 

, AB Nl N ( 9 , 9 ) 


ME MST 111 


DIMFNSION AMN I T (6,6) ,WM(3,6) , WMT(6,3) , EM{3,3) 9 MEMST II 2 

1 TN ( 6 » 1 ) , ZINT (1*6) , Z 1 ( 6 » 6 ) , 12 (6,6) MEMST 1 1 3 

DIMENSION Y L ( 3 ) , XL ( 3 ) MEMST 1 14 

DOUBLE PRECISION ZINT , XL , YL , TERM , AMNI T , WM , WMT , EM MEMSTI 15 
1 TN * Zl , 12 MEMST I 16 

DATA LA,LB,LC / l , 2 , 3 / MEMSTI 1 7 

DATA WM / 1.000,4*0.000, 1.000,2*0.000,1. 0DO,O.OOG,l*OOO f 7*O. 000 / MEMST118 


DATA WMT / 1.000,8*0.000, 1.000,3*0. 000,2*1. 000, 3*0.000 / 
DATA AMN I T , EM , TN / 51*0.000 / 

XL T LB) = XL L ( IE, 2) 

XL(LC) = XLL ( IE, 3) 

YL(LC) = YLL ( IE, 3) 

TERM = YOUNGS / ( 1.0 - P0ISS0**2 ) 

EM ( 1,1) = TERM 

EM( 1,2) = TERM * PUI SSO 

EM ( 2 , 1 ) = EM( 1,2) 

EM ( 2 , 2 ) = TERM 

EM { 3,3) * ( 1.0 - PQISSG ) * TERM / 2.0 

AMNINt 1,1) * -1.0 / XL ( LB ) 

AMNINt 1,3) = - AMNINt 1, 1) 

AMN IN ( 2, 2 ) = AMNINt 1,1) 

AMN I N ( 2,4) * AMNINt 1,3) 

AMNIN (3,1) = ( XL(LC) - XL ( LB ) ) / XL ( LB ) / YL(LC) 

AMN IN ( 3, 3 ) = - XL(LC) / XLtLB) / YL(LC) 

AMNINt 3,5) = 1.0 / YLtLC) 

AMN IN (4, 2) = AMN IN (3,1) 

AMNINt 4, 4) = AMNINt 3, 3) 

AMNIN (4, 6) = AMN IN { 3,5) 

AMNINt 5, I) = 1.0 
AMNINt 6, 2) = 1.0 


AMNINt 1,1) * “1.0 / XL t L 
AMNINt 1,3) := “ AMNINt 1, 1 
AMNINt 2, 2 ) = AMNINt 1,1) 
AMNINt 2,4) * AMNINt 1,3) 
AMNINt 3,1) = ( X L ( LC ) - 
AMN I N ( 3 , 3 ) = “ XL ( LC ) / 
AMNINt 3,5) = 1.0 / YLtLC 
AMN IN (4, 2) = AMNINt 3,1) 
AMNINt 4, 4) = AMNINt 3, 3) 
AMNIN (4, 6) = AMN IN { 3,5) 
AMNINt 5 , I) = 1.0 
AMNINt 6, 2) = 1.0 
DO 10 I * 1,6 
Z I NT ( 1 , I ) = 0.0 
DO 10 J = 1,6 
AMNITt I, J) - AMNINt J, I ) 
TNt 1,1 ) = THt LAA ) 

TNt 3, 1) = THtLBB ) 

TNt 5, 1) = IHt LCC ) 

CALL ZINT! t IE, ZINT ) 

DC 15 J = 1,6 

Zl ( 1 , J ) = 0.0 

DlJ 15 K - 1,6 

Zlt 1 , J ) = Zltl.J) + ZIN1 

Z?( l, 1 ) = 0.0 

DO 20 K = 1,6 

12 (i,l) = Z2(i,n + zit: 

DU 25 I = 1,6 
DO 25 J = 1, 3 


Z1(1,J) + Z I NT ( 1 ,K ) * A M N I N ( K , J ) 
0.0 
1,6 

Z2( 1, 1 ) + Zlt i,K) * IN (K , 1 ) 

1,6 


MEMSTI 19 
MEMSTI 20 
MEMSTI 2 l 
MEMSTI 22 
ME MST I 23 
MEMSTI 24 
MEMSTI 25 
ME MS T I 26 
MEMSTI 27 
MEMSTI 28 
MEMST I 29 
MEMSTI 30 
ME MS TT 31 
MEMSTI 32 
MEMSTI 33 
MEMSTI 34 
MEMSTI 35 
MEMSTI 36 
MEMST I 37 
MEMST I 38 
MEMSTI 39 
MEMSTI 40 
MEMSTI 41 
MEMSTI 42 
MEMSTI 43 
MEMST I 44 
MEMST I 45 
MEMSTI 46 
MFMSTI47 
MEMSTI 48 
MEMST I 49 
MEMSTI 50 
ME MS T l 5 i 
MEMSTI 52 
MEMSTI 53 
MEMSTI 54 
MEMS T 1 55 
MEMSTI 56 
MEMS T I 57 
MEMSTI 58 
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Z1M. J) 

= 

0.0 




MEMST ! 59 


00 25 K 

= 

If 3 




MEMSTI60 

2S 

Z1U,J) 

s 

Z1IUI 

4- 

m 1,1) * 

WMT( I , K ) * EM ( K , J ) 

MEMSTI 61 


U0 30 I 

= 

if 6 




ME MS T I 62 


CO 30 J 

= 

If 6 




MEMSTI63 


Z2( I«J) 

«s 

0.0 




MEMST I 64 


DO 30 K 

s 

If 3 




MEMSTI 6b 

30 

12 { I » J ) 

= 

12 t I » J ) 

4- 

Zl(ltK) * 

WM { K , J ) 

MEMST 166 


CO 3b I 


If 6 




MEMS T 1 67 


DO 3b J 

= 

i f 6 




MEMST I 68 


Z1 ( I, J) 

SE 

0.0 




MEMSTI 69 


DO 3b K 

= 

1,6 




MEMS T I 70 

3b 

m i,j ) 

JS 

Zl< 1* J) 

4- 

AMN I T { I ,K) 

* Z2 ( K , J ) 

MEMST I 7 1 


DO 40 I 

at 

if 6 




MEMSTI 72 


00 40 J 

= 

1,6 




MEMS T I 73 


ELMSM ( I 

• J) 

= 0.0 




MEMSTI 74 


CO 40 K 

s 

1,6 




MEMS T I 75 

40 

ELMSM( I 

t J) 

= ELMSMil 

,J) 4- 21 ( I 

, K ) * AMNI N ( K, J ) 

MEMSTI 76 


RETURN 






MEMSTI 77 


END 






MEMS T I 78 



o o r> o n o 


SUBRUUT I NE Z I NT 1 I IE, ZINT ) 

USING GAUSSIAN QUADRATURE, INTEGRATE THE FOLLOWING FUNCTIONS OVER 
THE SURFACE OF THE TRIANGLE 

F(XLtYL) * UO 
FI XL , YL ) * XL 
FI XL* YU = YL 


COMMON 

X ( 

100) 

, 

Y 1 

100) , z 

I 100) , TH 

( 100) 

1 




XLL I 100,3) , YLL I 

100,3) , 


2 

RAPANGI 

50) 

, 

ZGL I 

50) , RHUB 

( 50) , RTIP 

I 50) 

3 

THHUB ( 

50) 

, 

THTIP I 

50) , 

EDCM 

I 3,3) 

4 

RHU , 



PUIS SU , 

YUU,NGS « RADGEN , 


5 

NGENLI , 

L I NE I 

, 

NEXT I 

100,3) , NP , 

NT , 

6 

ELMS Ml 6, 

6) , 

AMNIN l 6*6) 

, ELBSM(9,9) 

, ABN I N I 9 , 9 ) 



1 XILIIO) , XIRI10) 

DIMENS ION YU 3.1 * XL I 3 ) 

DOUBLE PRECISION YO * HT , XO , ZINT 
I XIL , XIR * XL * YL 

DATA L A* LBfLC / 1,2, 3 / 


XIIIO) , AREA (10) 


H , Y I 


XI 


AREA 


-.86506336668899 

14887433898163 

.67940956829902 

. 149451 34915058 
.29552422471475 
.21908636251598 


-.67940956829902 , 
.14887433898163 , 
.86506336668899 , 

.21908636251598 , 
.29552422471475 , 
.14945134915058 , 


DATA A / -.97390652851717 

1 -.43339539412925 

2 .433395394 12925 

3 .97390652851717 

DATA H / .06667134430869 

1 .26926671930100 

2 .26926671930100 

3 .06667134430869 
XL I LB ) = XLL I I E , 2 ) 

XLILC) = XLL I IE, 3) 

YLILC) = YL LI IE, 3 ) 

YO = 0.5 * YLILO 

DO 3 I = 1,10 

Y I I I ) = YO + A(I) * YO 

XIL I I) XLILC) * YU I) / YL(LC) 

XIRII) = X L I L 8 ) - I XL(LB) - XLILC) ) * Y I ( I ) / YLILC) 

IF ( I .NE. 1 ) GO TO 2 

HT - 0.0 

DO 1 J - 1, 10 

HT = HT + HI J) 

AREA! I )■- XL I LB) * I 1.0 - All) ) * 0.25 * HT 
Z I N T ( 1 1 6 ) = 2 l N T l l , 5 ) 4 DABS I YLILC ) ) * 0.5 * AREA II ) * HI I ) 

ZINT I 1 , 3 ) = Z I N T I l , 3 ) +UAB SI YLILC) ) * 0.5 *YI(I) * AREA! I ) * H(I) 

DO 5 I = 1, 1C 

XO = XIL II) ♦ 0.5 * ( XIR(I) - XIL II) ) 

AREA! I )= 0.0 
CO 4 J = 1, 1C 

XII J) = XU 4 A I J) * I XG - X I L ( 1 ) ) 

A RE A ( l ) = AREA! I) 4 XL (LB) * I 1.0 - All) ) * 0.25 * H(J) * XI I J) 

ZINTIUl) = Z 1 NT I l , 1 ) 4DABSIYLILO) * 0.5 * AREA ( I ) * HI I ) 

RFTUR-v 

END 


ZINT 1001 
ZINT 1002 
ZINT 1003 
ZINT 1004 
ZINT 1005 
ZINT 1006 
ZINT 1007 
, ZINT 1008 
ZINT 1009 
, Z I NT 10 10 
, ZINT 1011 
ZINT 10X2 
Z 1 NT 10 1 3 
Z I NT 10 14 
, ZINT 1015 
Z I NT 10 1 6 
Z I NT 10 1 7 
Z I NT 10 18 
Z I NT 10 19 
ZINT 1020 
Z I NT 102 l 
Z I NT 1022 
ZINT 102 3 
ZINT 1024 
Z I NT 1025 
ZINT 1026 
ZINT 1027 
ZINT 1028 
Z I NT 1029 
ZINT 1030 
Z I NT 103 1 
ZINT 1032 
Z I NT 103 3 
Z I NT 1034 
Z I NT 10 35 
ZINT 1036 
Z I NT 103 7 
Z I NT 1038 
ZINT 1039 
ZINT 1040 
ZI NT 104 l 
ZINT 1042 
ZINT 1043 
Z I NT 1044 
ZINT 1045 
ZINT 1046 
ZINT 1047 
ZINT 1048 
ZINT 1049 
Z I NT 1050 
ZINT 1051 
ZINT 1052 



*h eg m ^ tn 'O! 


C 

c. 


SUBROUTINE BENSTF ( LAA , LBB , LCC , IE ) 

CALCULATE THE ELEMENTAL LOCAL BENDING STIFFNESS MATRIX ( ELBSM ) 
COMMON 


BENS TOO I 
BENST002 
BENST003 


X _( 

„JLOO) , 

Y ( 

100) 

t 

l 

( 100) , TH 

t 100) 

, BENST004 



XLL ( 100,3) 

f 

YLL ( 

100,3) , 


BENST005 

RAPANGt 

50) , 

ZGL ( 

50) 

9 

RHUB 

( 50) , RTIP 

( 50) 

, 8ENST006 

THHUB ( 

50) , 

THT1P ( 

50) 

9 


EDCM 

t 3,3) 

,BENST00T 

RHO , 


P01SS0 , 

YOUNGS 

i » RADGEN , 


BENST008 

NGENL1 

t_ LINE1 

f 



NEXT 

( 100,3) , NP , 

NT , 

BENST009 


JELMSMJ 6j 6) , AMNI N (6,6) , ELBSM(9,9) , ABNIN(9,9> 

DIMENSION ABN IT ( 9,9) , 21(9,9) , Z I NT (9,9) 

DIMENSION YL ( 3 ) , XL(3) 

DOUBLE PRECISION ZJl , ZJ2 
1 ZINT , XL , 

DATA LA , LB , LC / 1 , 2 , 3 / 

_XL(LB) ~ XLJL( IE, 2) 


ZJ3 , ZJ4 
YL 


ZJ5 , ZJ6 , ABN IT 


Z1 


XLCLC) = XLL ( IE, 3) 

YL(LC) = YLL( IE,3) 

ABNINt 1, 1 ) = 1.0 
ABN IN ( 2,3) * -1.0 
ABN IN ( 3 , 2 ) = 1.0 

ABN INI 4,1) / XL I LB) / XL ( LB ) 

= 2.0 / XL (LB) 

= - ABNINl 4, 1) 

= 1.0 / XL ( LB ) 

- 3.0 * ( XL ( LC ) **2 - XL ( LB) **2 ) / ( XU LB ) *YL ( LC > ) **2 


ABNINt A, 3) 

ABNINt A, A) 

ABNINt 4,6) 

ABNINt 5, l) 

AJ|N IN ( 5 , 2 ) = “2.0 / YL ( LC) 

ABNIN t 5, 3 ) - 2.0 * ( XL ( LB ) - XL ( LC ) 


) * XL (LC ) / XL (LB ) / YL ( LC ) 


L _ / YL ( LC ) 

ABNINt 5,4) = -3.0 * t XL(LC) / XL ( LB ) 
ABN I N ( 5,6) m - { XL(LC) / YL(LC) )**2 
ABN IN( 5, 7 ) = 3.0 / YL ( LC') / YL(LC) 


YL(LC) )**2 
XL (LB) 


ABN IN ( 5 , 8 ) 
ABNINt 5, 9) 


- 1.0 / YL (LC ) 
XL ( LCJ / YL(LC) 


/ YL(LC) 


ABNINt 6 ,1) = 2. 0 / XL t LB )**3 
ABN INI 6, 3 ) = - 1 .0 / XL t LB ) 
.ABNJN!6 t 4) A m - ABNINt 6, 1 ) 

ABN IN t 6 , 6 ) = ABNINt 6,3 ) 

.ABN INt 7, 2 ) = ABN IN (6,3) 
ABNINt?, 5) = - ABN INt 6,3) 
ABNINt 1 ) = 6.0 * XL t LC ) / 
ABNINt 8, 2) = 2.6 * XL ( LC ) / 


/ XL (LB) 


XL t LB ) **3 / YL t LC ) **2 * ( XL ( LB ) -XL t LC ) 
XL (LB) / XL (LB) / YL(LC) 

ABN INtjB , .3) = ( XLtLB) - 3.0*XL(LC) ) * t XLtLB) - XL(LC) ) / 
l (XLtLB) * YL(LC) )**2 

ABNINt 8, 4) « 6.0 * XllLC) * t XL(LC) - XLtLB) ) / XL(LB)**3 / 

L J, YU LC )**2 

-2.6 * XL t LC ) / XLtLB) / XL ( LB ) / YL(LC) 

XL ( LC ) * ( 3 • 0*XL ( LC ) - 2.0*XL(L8) ) / ( XL(LB) * 

YL t LC ) )**2 

-1.0 / YL t L.C ) / YL(LC) 

2.0 * ( 2 • 0*XL ( LC )**3 - XL(LB)*( 3. 0*XL ( LC ) **2 - 
1 XL ( LB ) **2 ) ) / ( XLtLB) * YL(LC) J**3 

ABN I N 19 , 2 ) V t XLt LB ) **2 - XL(LC|»*2 ) / (XLtLB) * YU IX*) )**2 

ABN INI 9, 3.) *^2.6 * XL(LC) * ( XLtLB) - XL(LC) )**2 / XLtLB >**2 / 

i _ _ VL( LC)»*3 

ABN IN (9,4) *_2..0 * XL(LC)**2 * ( 3.0*XL(LB) - 

1 _ ( XL (LB) * YL(LC) )**3 

ABN IN ( 9,5) *= ( XL(LC) / XLtLB) / YULC) )**2 


ABNINl 8^, 5 ) 
ABN IN ( 8 , 6 ) 

L_ _ 

ABNJNt 8,9) 
ABNINt 9, 1) 


2.0*XL t LC ) ) / 


BENST010 
BENS TO l l 
BENST012 
BENS TO 13 
BENST014 
BENST015 
BE N S TO 16 
BENST017 
BENST018 
8ENST0 19 
BENST020 
BENST021 
BENST022 
BENS TO 2 3 
BFNST024 
BENST025 
BENST026 
BENST027 
8ENST028 
BENS 1029 
8ENST030 
BENS TO 31 
8ENST032 
BENST033 
BENST034 
BENST035 
BENS TO 36 
BENST037 
BENST038 
BENST039 
B6NST040 
)BENST04i 
BENST042 
BENST043 
BENST044 
BENST045 
BENST046 
BENST047 
BENS T 04 8 
BENST049 
BENST05Q 
BENST051 
BE NS T 05 2 
BENST053 
BENS TO 54 
BENST055 
BENST056 
8ENST057 
BENST058 


1 65 



ABN I N ( 9 , 6 ) = 2.0 * XULC)**2 * t XUIBI - XL(LC) ) / XL(LB)**2 / 
i YULC>**3 

ABN IN ( 9 , 7 ) = -2.0 / YL(LC)**3 
A8N IN ( 9, 8 ) = 1.0 / YL(IC)**2 
DC) 5 I = 1,9 
GO S J = 1,9 
ZINT-4 l • J I = 0.0 
S ABNlTt 1, J) = ABNINU, I ) 

CALL ZINT2 ( L A A , L B B , L CC ,7 J1,Z J 2, Z J 3 »Z J A , Z J 5 , Z J6 , 1 E ) 

Z I NT t A * A I = A • 0 * ZJl 
Z I NT ( A , V) = POISSU * ZINTtA.A) 

Z I N T ( A ,6 ) = 12.0 * ZJ2 

ZINT(A,7 > = A • 0 * ZJ3 

Z I NT ( A , 8 ) * A • 0 ♦ POISSO * ZJ2 

Z INT (A ,9 ) * POISSO * Z 1NT ( A* 7) * 3.0 

ZlNTtS S) = ZINTtA.A) 

Z I NT ( 5*6 1 = POISSO * Z INT I A » 61 
Z I NT (5,7) = POISSO * ZINTCA.7) 

ZINTI5.8) = Zl NT. I 4*8) / POISSO 

Z I N T ( 5 * 9 ) = Z I N T ( 4 * 9 ) / POISSO 

Z I NT { 6 , 6 ) = 36.^ * Z J A 

Z INT (6, 7) = 12.0 * ZJ5 

Z I NT (6, 6 ) = 12.0 * POISSO * ZJA 

Z I NT 16,9) = Z I NT ( 6.9 7 ) * POISSO * 3.0 

Z I N T ( 7 , 7 ) = 4.0 * ZJ6 + 8.0 * ( 1.0 - POISSU ) * ZJA 
Z I NT t 7 , 8 ) = A * 0 * ( 2.0 - POISSO ) * ZJ5 

' Z I NT ( 7,9) =12.0 * POISSO * ZJ6 

Z INT ( 8, 8 ) = 8.0 * ( 1.0 - POISSO ) * ZJ6 + A.O * ZJA 

Z I NT ( 8 , 9 ) =12.0 * ZJS 
Z l N T { 9 j 9 ) =36.0 * Z J 6 
CO 10 I = A, 8 
H - I * 1 
00 10 J = 11,9 

10 Z I NT ( J , I ) = ZI NT ( I , J ) 

ZJl = YOUNGS / ( 12.0 * I 1.0 - P0ISSQ**2 ) ) 

00 15 I = A, 9 

DO IS J = A, 9 

IS ZINTU.J) = ZINTII.J) * ZJi 
DO 20 I = 1,9 

DO 20 J = 1,9 

ZI ( It J) = o.o 
DO 20 K = 1,9 

20 Zl(I,J) = Z1(I,J) ♦ ABN I T ( I , K ) * ZINT(K,J) 

DO 2S I = 1,9 

DO 2S J = 1,9 

FLBStf ( I , J 1 = 0.0 
CO 2S K = 1, 9 

2S FLBSMt I, J ) = ELHSMI.J) + Zltl.K) * ABNI N ( K , J ) 

R F T UK N 
END 


BENST059 
BENS TO 60 
BENST06 l 
BENST062 
BENS T063 
BE NS TO 6 A 
BENST06S 
BENST066 
BENST067 
BENS T068 
BENS T069 
BENST070 
BENST071 
BENSTO 72 
BENST073 
8ENST07A 
BEN S TO 7 S 
BENST076 
BENST077 
BENS TO 78 
BENST079 
8ENST080 
BENST081 
BENST082 
BENST083 
BENST08A 
8ENST08S 
BENST086 
BENST087 
8ENST088 
BENS TO 89 
8c NS TO 90 
3ENS i09i 
* .NST092 
BENST093 
BENST09A 
BENS T095 
BENST096 
BENST097 
BENST098 
BENST099 
BENS T 100 
BENS T 101 
BENS T 102 
BENST1 03 
BENS T l OA 
8ENST105 
BENST106 
BEN 107 
BENS 1 108 
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2 + XL ( L 6 I *TH( LCC ) *Y I ( 1 ) )** 3 * XLUB)*( 1.0 - All) ) * 0.25 ZINT2059 

3 * H(J> / XL t LB )**3 / YL ( LC ) **3 ZINT2060 


ARE A( I 

• 1 ) 

= 

AREAU 

, l ) 

♦ TERM 



Z-I -NT 2 0.61 

ARE A( I 

fi) 

= 

AREAt I 

,2) 

♦ TERM * 

X I ( J ) 


ZINT2062 

AREA( I 

,3} 

s 

AR E A t I 

,3) 

♦ TERM * 

VI t 1 ) 


Z l NT 206 3 

AREA! I 

) 

= 

AREAt I 


♦ TERM * 

XI < J}**2 


Z 1 NT 2064 

AREAt I 

,5) 

= 

AREAt I 

,5) 

♦ TERM * 

x i < j ) * vim 

ZINT2065 

ARE A( I 

t 6 > 

* 

AREAt I 

* 6 ) 

♦ TERM * 

Ylt I >**2 


ZINT2066 

ZJl = 

ZJl 

+ 



0.5 * 

Ht 1 > 

* AREA (I 

1 1 ) *OABS { YL ( tC') ) 

Z I NT 2067 

ZJ2 = 

ZJ2 

«• 



0.5 * 

HU) 

* ARE A 1 1 

$ 2 ) *DABS ( YL t LC ) ) 

Z f NT 2068 

ZJ3 = 

Z J 3 

♦ 



0.5 * 

Ht I ) 

* AREAt I 

» 3 ) ♦DABS ( YL ( LC ) ) 

ZINT2069 

l J4 * 

Z J4 

♦ 



0.5 * 

Ht i ) 

* AREAt ! 

,41 *DA8 S t YL t LC ) ) 

ZINT2070 

ZJ5 = 

ZJ5 

♦ 



0.5 * 

Ht I ) 

* AREA ( I 

,5) *DAB 5 ( YL 1 1X1 ) 

Z I NT 207 1 

ZJ6 * 

Z J 6 

•f 



0.5 * 

Ht! ) 

* ARE A 1 1 

,6) *DAB S t YL t LC ) ) 

Z I NT 20 72 

RETURN 








ZINT2073 

END 









ZINT2074 


l6B 



nnnnnnnnonn o o r> o 


subruutine mcminr ( L AA , LBB, LCC* I E ) 

CALCULATE THE LOCAL MEMBRANE INERTIA 
MATRIX ItLMIMJ FUR A TRIANGULAR 
ELEMENT, 


MEM I NOO 1 
MEM I NO 02 
ME MI NOO 3 
MEM I NO 04 
ME MI NO 05 


COMMON 

X ( 

100) 

, 

Y { 

100) 

, Z ( 100) , 


( 100) 

, ME M l NO 06 

1 




XLL ( 100,3) 

, YLL ( 100,3) , 



MEM] NO 07 

2 

R AP ANG ( 

50) 

, 

ZGL ( 

50) 

, RHUB ( 50) , 

RT IP 

C 50) 

, MEM I NO 08 

3 

THHUR ( 

50 ) 

t 

THTIP ( 

50) 

, 

EDCM 

I 3,3) 

. , MEM I N009 

4 

RHO , 



POISSO , 

YUUNGS , RADGEN , 



MEM 1 NO 10 

5 

NGENLI , 

LINE! 

» 


NEXT ( 100,3) 

, NP , 

NT , 

MEM! NO 1 1 

6 

E LMSM { 6 * 

6) , 

AMN I N ( 6 , 6 ) 

, ELBSM(9,9) f ABNI N (9,9) 

, 

MEM I NO 1 2 


SIGMAXI 100) 


SIGMAYI 100) 


EL ST IF < 18, 18) 


8 TAUXY(IOO), 

9 EL INR( 18,18) 
DIMFNSIUN AMN IT (6,6) , 

1X1(10) , AREA ( 10,6) , 
21 INI (6) , R 2 { 6 » 6 ) 
DOUBLE PRECISION YO , 


ELSSM{9,9)» ME X ( 100 , 8 ) , IMEXdOOI, 

, ELMI M ( 6 ,6 ) , EL8IM(9,9) 

R l ( 6 , 6 ) , A ( 10 ) , HI 10) , Y I C'lO) , 
XIL(iO) , XIR(IO) , XL ( 3 > , YL 4 31 , 


DATA 

DATA 


XL , 

LA,LB,LC / 


YL 

1 , 2 , 


XQ , 
ZlNT 
/ 


TERMl 

, R2 


AMNIT , R 1 


H 


YI 


A / -.973906*52851717 

1 - .43339539412925 

2 .4333 / "39412925 

3 .97390652851717 

CATA H / .06667134430869 

1 .26926671930100 

2 .26926671930100 

3 .06667134430869 
XLL ( IE, 2) 

X L L ( IE, 3) 

YLL( IE, 3) 

* 1,6 
0.0 
* 1,6 
0.0 
0.0 

0.0 

AMN IN ( J , I ) 


-.86506336668899 

-.14887433898163 

.67940956829902 

/ 

. 14945134915058 
.29552422471475 
.21908636251598 


-.67940956829902 
. 14887433898163 
.86506336668899 

.21908636251598 

.29552422471475 

.14945134915058 


XL ( LB ) 

XL(LC) 

YL(LC) 

DO 10 
Z INTU ) 

DU 10 
R i ( I , J ) 

R2( I,J) 

E L M I M ( I , J ) = 

10 AMN l T ( I, J ) = 

USING GAUSIAN QUADRATURE, INTEGRATE THE FOLLOWING FUNCTIONS OVER 
THE SURFACE (IF THE TRIANGLE 

F ( XL , YL I = TERM 
F ( XL , YL ) □ TERM * XL 
F ( XL » YL ) * TERM * YL 
F ( XL , YL ) - TERM * XL* YL 
F ( XL , YL ) = TERM * XL**2 
E ( XL , YL ) = TERM * YL**2 


WHERE 

TERM 


(XL(LB)*YL(LC) ♦ ( XL I LC ) - XL ( LB ) ) *YL - YL ( LC ) *XL*TH ( L A A I 


ME M I NO 1 3 
MEM l NO 14 
MEM I NO 15 
MEM I NO 16 
ME M I NO 17 
MEM I NO 18 
MEM I NO 19 
ME MI NO 20 
MEM I NO 2 1 
, MEM I NO 2 2 
, MEMIN023 
, MEMIN024 
MEMIN025 
, ME M I NO 26 
, MEMIN027 
, MEMIN028 
MEM :I NO 2 9 
ME M I NO 30 
MEM! NO 3 1 
MEM I NO 32 
ME M l NO 3 3 
MEM I NO 34 
MEMIN035 
MEM I NO 36 
MEM I NO 3 7 
ME M I NO 3 8 
MEM I NO 39 
MEM I NO 40 
MEM! NO 41 
MEMIN042 
MEMIN043 
ME MI NO 44 
MEMIN045 
MEM1N046 
MEMIN047 
MEMIN048 
- MEMIN049 


( X L ( LC ) * YL - YL { LC ) *XL ) * TH { LbB ) ♦ 
YO - 0.50 * YL(LC) 

DO 35 1-1,10 

Y I ( I) = YU ♦ A ( l ) * YU 

X I L ( I ) = X L ( LC ) * Y I I I) / YL(LC) 

XIR(I) = X L ( L Li ) - (XL(Lb) - XL < L C > ) *Y I < I ) 


XU 

DU 

CO 


= X l L ( I ) + 
20 J - l, 
15 K - 1 , 


0.5*1 X I R ( I )-Y I LID) 
10 
b 


XL (LB) *TH(LCC) *YL ) / XL ( LBMEM I N050 

MEM I NO 51 
MEMIN052 
ME MI NO 5 3 
ME MI NO 54 

/ YL (LC) MEM I NO 55 

ME MI NO 5 6 
MEMIN057 

MF M T 
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15 

20 


Zb 


30 

3b 

C 


AO 


A 5 


50 


AREA(J,K) = 0.0 

XI tJ) = XO + A(J)*{XO-XIL( I )) 

CO 25 J = I, 10 

TFRM1 = XL ( L B ) * I 1.0- A { l ) )*0. 25*H l J ) * I I XL I L6 ) ♦ YU LC ) 

1 MXULO-XULB) I+YIM i-YL(LC)*XI ( J) )*TH(LAA) 

2 + ( YL l LC ) *X 1 ( j)-XLILCi*YI< I ) ) * T.H.I L B B ) ♦ XL I LB) * TH (LCC ) 

3 *YI1 I n/XULBI/YULC ) 

ARE A t I « 1 ) = AREA I I , l ) + TERM! 

ARE A ( 1*2) = AREA { I , 2 ) + TERM 1* XI C J I 
AREA! 1 * 3 ) = ARE A ( 1 » 3 I + TERM 1 *Y I I I ) 

AREA! I, A) = AREA I 1 # A I + TERM 1*X I U > * Y U I) 

ARE A { 1,5) AREA ( 1 , 5 ) + TERM 1# XI (J) **Z 

AREA ( 1*6) = AREA I I , 6 ) ♦ TERM 1*YI I ( > **2 
CONTINUE 

TERM1 -DABS I YLILC) ) * 0.5 * HM ) 


DO 30 

J 

= 1,6 

Z INTI J ) 

= 

MNT(J) ♦ TERM 1* AREA ( 1 , J ) 

CONTI NUC 

END OF INTEGRATION 

R2 ( 1 , 1 ) 

= 

Z INTI 5 ) *RHQ 

R 2 ( l * 3 I 

- 

l INT I A ) *RHO 

R2 I 1,5) 


Z I NT I 2 ) *RHO 

R2I 2,2) 

= 

R2I 1, i ) 

R2I2.A) 

:= 

R2( 1,3) 

R2 I 2 » 6 ) 

- 

R2I 1,5) 

R2I 3, 3) 

= 

Z I N T I 6 ) *RHQ 

R?( 3,5) 

= 

l INTI 3)*RH0 

R2I A, A) 

- 

R2I 3, 3) 

R2( A, 61 

= 

K2I 3,5) 

R? ( 5, 5 ) 

- 

ZINTI l )*RHO 

R2 ( 6 , 6 ) 

- 

R 2 I 5 , 5 ) 

DO AO 

I 

= It 5 

II = 1+1 
DO AC 

J 

= 11,6 

R2U, I ) 

= 

R2( I, J ) 

DO A 5 

I 

= 1,6 

DO A 5 

J 

= 1,6 

DU A 5 

K 

= 1,6 

R 1 ( I, J) 

- 

R1I I, J J + AMNITI I , K )*R 2 ( K 

CO 50 

I 

= 1,6 

DO 50 

J 

= 1,6 

DC) 59 

K 

= 1,6 


ELM I M ( I t J } = ELM l M{ I , J ) + R1 { I , K ) *AMN I N I K , J ) 
RETURN 

END 


MEMIN056 

MEMIN060 

MEMI N061 

MEMIN062 

ME M I NO 63 

MEMI N06A 

MEMIN065 

MEMIN066 

MEM I NO 6 7 

MEMIN06B 

MEMIN069 

MEMI NO 70 

ME M I NO 7 1 

MEM I NO 72 

ME M I NO 7 3 

MEMIN07A 

MEM I NO 75 

MEM I NO 76 

ME M I NO 7 7 

MEM! NO 7 8 

MEM INO 79 

MEMIN080 

MEMIN081 

MEMIN082 

MEMIN083 

MEMIN08A 

MEMIN085 

MEMIN086 

MEMIN087 

MEMIN088 

MEM1N089 

MEMIN090 

ME MI NO 9 i 

MEMIN092 

MEMIN093 

MEMIN09A 

MEMIN095 

MEMIN096 

MEMIN097 

MEMIN098 

MEMIN099 

ME M I Nl 00 

MEMIN10L 

MEMIN102 

ME M I N 10 3 
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n o r* o r> noon n n o o n o o o o 


SUfi ROUT I NE BE^lNR ( L A A , LBB, LCC, IE) 

CALCULATE THE LOCAL BENDING INERTIA MATRIX (GIB I M, ) FOR A 
TRIANGULAR ELEMENT. 


COMMON 

X t 

100) 

, 

Y 

( 100 ) , z 

( ICO) , TH I 100) 

» 8EN I N005 

l 




XLL ( 

100,3) , YLL I 

100,3) , 

BENIN006 

2 

RAPANGI 

50) 

t 

ZGL 

( 50) , RHUB 

1 50) , RTIP ( 50) 

, BEN I NO 07 

3 

THHUB ( 

50) 

9 

THTIP 

{ 50) , 

EDCM ( 3,3) 

, BEN I NO 08 

4 

RHO , 



POISSO 

, YOUNGS , RADGEN , 

BENIN009 

5 

NGENL I 

, LINE! 

f 

NFXT ( 

LOO, 3) , NP , NT , 

BEN l NO 10 

6 

E L M S M ( 6 

t 6 ) , 

AMN IN ( 6, 

6) , ELBSM ( 9 , 9 ) 

, ABN IN (9,9) , 

BEN I NO 11 


7 SIGMAX(LOO) , S I GMA Y 1 100) , ELSTIFU8, 18) , 

8 T AUX Y ( 100), ELSSM( 9,9), MEX(100,8>, IMEXUOO), 

9 ELINRt 1 8 » 18) , ELMIM(6,6) , ELB I M ( 9 , 9 ) 

DIMENSION A B N I T ( 9 , 9 ) , RL(9,9), R2(9,9>, A(lO) f H(10), YKIO), 

1 XI(IO), AREA ( 1 0» 2 8 ) f XILIIO), XIR<10), XL ( 3 ) * YL i 3 ) , 

2 ZINK 2d) 

COUBLE PRECISION YO , XO , TERM l , ABNlT , Ri , R2 , A , H , 

1 YI , XI , AREA , X I L , XIR , XL , YL , ZINT 

DATA LA, LB, LC / 1,2, 3 / 

DATA A / - • 9 7 390652851 717 , -. 86506336668899 , - . 6794 0956829902 

1 - .43 3 395394 12925 , -. 14887433898163 , .14887433898163 

2 .43339539412925 , . 6 7 9409 56 8299 02 , .86506336668899 

.97390652851717 


14887433898163 

86506336668899 


DATA H / .06667134430369 , .14945134915058 , .21908636251598 

1 .26926671930100 » . 2 9 5 52 42 247 1 4 75 , . 2 955242247 1 4 75 

2 .26926671930100 , .21908636251598 , .14945134915058 

3 .06667134430869 / 

XL(LB) = X LL ( IE, 2) 

XL(LC) = XLL( IE, 3) 

YL(LC) = YLL ( IE, 5) 

DU 10 I = 1,9 
00 10 J = 1,9 

r i ( r , j ) = o.o 

R 2 ( I , J ) = 0.0 
EL B I Ml l , J ) = 0.0 
ID ABN IT ( I ,J) = ABN I N ( J , I ) 

HU 15 I = 1,28 
15 Z IN Tin = 0.0 

USING GAUSSIAN QUADRATURE, INTEGRATE THE FOLLOWING FUNCTIONS 
OVER THE SURFACE OF THE TRIANGLE. 


F ( XL , YL ) 

= 

TERM 



BENIN042 

F ( XL , YL ) 

= 

TERM 

* 

YL 

BEN I NO 4 3 

F I X L » Y L ) 


T E R M 

* 

YL**2 

BENIN044 

F ( XL , YL ) 

.= 

TERM 

* 

Y L * * 3 

BE NIN045 

F ( XL » YL ) 

= 

TERM 

* 

YL**4 

BENIN046 

F ( X L , Y L ) 

- 

TERM 

$ 

YL**5 

BENI NO 4 7 

F (XL , YL ) 


TERM 

* 

YL**6 

BENIN048 

F (XL , YL ) 

= 

TERM 

* 

XL 

BENIN049 

FI XL ,YL ) 

= 

TERM 

* 

XL* *2 

BEN I NO 50 

M XL , YL ) 

= 

TERM 

* 

X L * * 3 

BE NINO 51 

F (XL ,YL ) 

= 

TERM 

* 

X L * * 4 

BE N l NO 5 2 

F( XL ,YL ) 

* 

TERM 

* 

XL * * 5 

BE NINO 5 3 

F( XL ,YL ) 

= 

TERM 

* 

X L * * 6 

BENIN054 

r (XL ,YL ) 

■= 

TERM 

* 

XL * YL 

BEN I NO 5 5 

F ( XL , YL ) 


TERM 

* 

XL * YL * *2 

BENI NO 5 6 

F ( XL ,YL ) 


TERM 

♦ 

XL * YL * * 3 

BEN I NO 5 7 

F ( XL , Y L ) 

= 

TERM 

* 

XL * YL * *4 

BE N I NO 58 
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ononooooooonoo 


F ( X L » Y L ) = TERM 
F ( X L , Y L ) * TERM 
F ( XL t YL ) = TERM 

F{ XL , YL ) ± TERM 

F ( X L » Y L ) = TERM 
F ( XL » YL ) - TERM 
F ( X L , Y L ) - TERM 
F ( XL ,YL) - TERM 
F ( XL # YL ) = TERM 
F ( XL > YL ) = TERM 
F ( XL * YL ) = TERM 

WHERE 

TERM = ( ( XL (LB) * YL ( L C ) + (XI 


XL * YL**6 
XL**2 * YL 
XL**? * YL* 
XL**? * YL* 
XL**? * YL* 
XL** 3 * YL 
XL** 3 * YL* 
XL * *3 * YL* 
XL**4 * YL 
XL **4 * YL* 
XL** 5 * YL 


( XL ( LC) - )(L ( LB ) ) * YL 


( XL ( LC ) * YL - YL ( L 
YO = 0.50 * YL(LC) 

CO 40 I = 1,10 
Y I ( I) = YU 4 A(I) * YU 
XI LU ) = XL(LC) * Y I ( I) / 
X I R { I ) = XL(LH) - ( XL ( LB ) 


Y L ( L C ) * X L ) * T H ( L B B ) 


YL(LC) 

- XU LC) I 


xo * xiun ♦ o, 

DO 2.5 J = 1,10 
DO 20 K = 1,28 
AR E A ( J , K ) = 0.0 
X I { J ) = XO f A ( v, 
DU 30 J = MO 


( XIR ( I) 


x i l n n 


X I { J ) = XO + A ( J ) * (XU - X I L I I ) ) 

OU 30 J = 1,10 

TERM! - XL(LB) * (1.0 - AID) * 0.25 * H(J) * (CXLCL8) * YL(LC) 

1 (XL(LC) - XL ( L B ) ) * YI(I) - YL ( LC ) * XI ( J) ) ♦ TH(LAA) * 

l (YL(LC) * X I ( J ) - XL ( LC ) * Y I (!) I * TH(LBB) 4 XL ( LB ) * 

3 TH(LCC) * Y l ( I ) ) / XL ( LB } / YL ( LC ) 


ARE A ( 1,1) 
ARE A ( 1,2) 
AREA ( 1,3) 
ARE A ( I ,4) 
AREA! I ,6) 
ARE A ( 1,6) 
AREA { 1,7) 
AREAt I ,8) 
ARE A ( I ,0 ) 


A K E A ( 1,1) 
AR E A ( 1,2 ) 
AREA ( 1,3) 
A RE A { 1,4) 
ARE A ( 1,5) 
AREA ( 1,6) 
AREA ( 1,7) 
ARC A ( 1,8) 
ARE A ( 1,9) 


TERM 1 

TERM 1* Y 1 i I ) 
TERM l* Yl ( I ) **2 
TERM 1 *Y I ( I 1**3 
TERM) *Yl ( I )**4 
TERM 1* Yl ( t ■)■■**. 5 

TER M 1* Y I ( I ) **6 
TERMl*X! ( J ) 

T FRM 1 * X I ( J )**? 


A RE A ( I , 1 0 ) ~ AREA ( 1,10)4 TERM 1* X I ( J ) **3 
AREA{ 1 , 1 l)" AREA ( l .11)+ TERM 1*XI ( J ) **4 
ARE AC I ,1 2 ) ~ ARE A ( 1, 12)+ T ERM 1 *X I ( J ) **b 
ARE AC l , i 3 ) = ARE AC l , i 3) + TERM 1*X I C J ) **6 


ARE A ( I f 14) = 
ARF A ( I , 1 6 ) = 
ARE A( I , l6) = 
ARF A ( I , l 7 ) = 


AREA! I, 14)+ TERM l*Xt( J )*YI ( I J 
AR EA ( I , l 6 ) + TERM 1* XI ( J)*YI (l )**2 
ARE At I , 16) + TERM l *X I ( J)*YI ( 11**3 


ARE A ( 1,16)= ARE A ( I , 1 6 ) ♦ T ERM 1 *X I ( J ) *Y I ( I ) **3 
ARF A( I 9 l 7 I = AREA t 1 * 1 7 ) + TERM 1*X H J ) *Y III ) **4 
AR E A ( 1*16)= A R E A ( I ,18)+ TERM 1* X !( J ) * Y f 1 1) **5 
ARE A{ 1,14)'= A R E A ( I ,19) + TERM L*X.l ( J ) **2*YI ( I ) 

AR E A ( I , ? 0) = AREA ( 1 , 2C) + T ERM 1 * X I C J ) **2*Yl ( I ) **2 


A R F A ( I ,7n = 
A R E A ( I ,22) = 


ARE AM , 2 l > + T £ R M 1 * X I ( J )**2*YI ( I)** 3 
AREA( I ,2?) + TERM 1 * X 1 ( J )**2*Yl ( I ) ** A 


AREA! I , ? 3 ) = ARC A ( I , ? 3) + T ER M 1 * X I ( J ) **3 * Y I ( I ) 

ARE A( I , 7 4 ) = AKEAU ,24) + T F R.M 1 * X I { J ) ** 3*Y I ( I ) **2 
AREA ( I , 2 b ) = ARE A C l , 2 6 ) + T FRM 1* X l ( J ) ** 3*Y I ( I ) ** 3 


AREA ( I , ? 6 ) = AREA! ! ,2b) + IERMl*XI ( J)**4*YI (T ) 

ARF A< l, .2/1= AREA ( I ,??)♦ TERM 1* XI (J)**4*YI ( I ) **? 
AREA! I ,?ri )= ARbAC 1 ,?8)+ T F R K 1 * X T ( J ) * * 6 * Y l ( I ) 
CONTI MJr 


BEN1N059 
BENI NO 60 

<2 BENIN061 

'3 BFNIN062 

* A B6NIN063 

BENI NO .64 

*2 BENIN065 

* 3 BEN I NO 66 

BEN I NO 6 7 

*2 BE NINO 68 

BENI NO 69 
BEN I NO 70 

ft - YLCLC)*XL*THCLAAI - BENIN071 
XL ( LB) * TH { LCC ) * YU / XL ( LBBE N I NO 72 

BE NINO? 3 
BENIN074 
BEN I NO 75 
BEN I NO 76 

! ) / YL ( LC) BEN I NO 7 7 

BEN l NO 7 8 
BEN I NO 79 
BENI NO 80 
BENIN081 
BE NINO 8 2 
BENI NO 8 3 

J) * ((XL (LB) * YL(LC) + BENIN084 

) * X! ( J) ) ♦ THCLAA) * BENIN085 

* THCLBB) 4 XL l LB) * BENIN086 

BEN I NO 8 7 
BEN I NO 8 8 
BEN I NO 8 9 
BENIN090 
BENIN09I 
BEN I NO 92 
BENIN093 
BENIN094 
BEN I NO 95 
BENI N096 
BE N I NO 9 7 
BE N I NO 9 8 
BFNI N099 
BENI Nl 00 
8ENIN101 

**2 .BEN IN 1.02 

►*3 BENIN103 

►*4 BENIN! 04 

**■5 BENI Nl 06 

I) BENIN106 

M**2 BEN I N 1 0 7 

I)** 3 BFNI Nl 08 

I ) ** 4 BENIN109 

I ) BEN I N 1 10 

I ) * * 2 BENINI 11 

I ) ** 3 BENI Nil? 

I) BENINI 13 

I) **? BENINI 14 

I) BENINI 15 

BENIN! 16 
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3b 

AO 


4b 


TU 


TERM1 =1 

DABS 1 YLUCJ ) * 0.5 ♦HU) 

BEN I NI 17 

DO 3b J 

= 

1,28 

BEN I NI 18 

Z INK J) 

a 

7 INT(J) 4- T ERM 1 ♦ ARE A ( I, J) 

BEN I Nl 19 

CONTINUE 


BENIN120 

RlUtl) 

a 

Z IN T C 1 ) ♦ RHO 

BEN I NI 2 1 

RU 1,2) 

a 

Z 1 N T ( 8 ) ♦ RHO 

BENI N 122 

Rl( 1,3) 

a 

l INK 2 ) ♦ RHO 

BENIN123 

Ri ( 1,4) 

.a 

Z INT ( 9 ) ♦ RHO 

BEN1N124 

Rll 1,5) 

a 

Z I NT ( 3 ) ♦ RHO 

BEN INI 25 

R 1 ( 1 1 6 ) 

= 

Z INT €1-01* RHO 

BENIN! 26 

R1 (1,7) 

a 

ZINK 19) ♦ RHU 

BEN INI 2 7 

Rl( 1,8) 

= 

Z INK 15.)* RHO 

BEN I Nl 28 

Rl( 1,9) 

= 

Z INT ( 4 ) ♦ RHO 

BENIN 129 

R 1 ( 2 , 2 ) 

= 

R 1 ( 1 , 4 ) 

BENIN! 30 

R 1 ( 2, 3 ) 

= 

Z I NT (14)* RHU 

BEN INI 31 

R 1 ( 2 , 4 ) 

= 

RU 1,6) 

BEN I Nl 32 

R 1 ( 2,5) 

= 

R 1 1 l , 8 ) 

BEN I NI 33 

R 1(2,6) 

= 

Z I NT ( 1 1 ) * RHO 

BENIN! 34 

R.l (2,7) 

= 

Z l NT (231* RHO 

BENI Nl 35 

R l ( 2 , 8 ) 

= 

ZINK 20)* RHO 

BEN INI 36 

R 1 ( 2,9) 

* 

Z INK 16)* RHO 

BEN I NI 37 

R 1 ( 3, 3 ) 

= 

RI (1,5) 

BENIN! 38 

R 1 (’3,4 ) 

a 

R l ( 1 , 7 ) 

BEN I NI 39 

R 1 ( 3 , 5 ) 

= 

RK 1,9) 

BEN INI 40 

Rl( 3,6) 

a 

Rll 2,7) 

BE N I N 1 4 1 

Ri ( 3,7) 

= 

R 1 ( 2 , 8 ) 

BENI Nl 42 

R 1 ( 3 , 8 ) 

= 

R 1 ( 2 , 9 ) 

BENI N143 

Ri (3,9) 

= 

Z INK 5 ) * RHO 

BENIN144 

R 1 ( 4, 4 ) 

= 

R 1 ( 2 , 6 ) 

BEN I N 145 

R 1 ( 4, 5 ) 

= 

R 1(2,8) 

BEN INI 46 

R l ( 4, 6) 

- 

Z INT (12 ) * RHO 

BENIN! 47 

R 1(4,7) 

= 

Z INT ( 26 ) * RHU 

BENIN! 48 

Ri( 4,8) 

= 

Z.I NT(24) * RHU 

BEN I N 149 

Ri (4,9) 

= 

Z I N T ( 2 1 ) * RHO 

BENI Nl 50 

R 1 (5,5) 

= 

R 1< 3 , 9 ) 

BENI Nl 51 

R 1 ( 5 , 6 ) 

- 

R 1 ( 4 , 8 ) 

BEN I Nl 52 

R 1 ( 5 » 7 ) 


R U 4 1 9 ') 

BEN I NI 5 3 

RI (5,8) 

■a 

Z INK 17) * RHO 

BEN INI 54 

RI (5,9) 

■ a 

ZINTI6) * RHU 

BEN INI 55 

R i ( 6,6 ) 

= 

Z INK 13) * RHU 

BENIN156 

R 1 ( 6 , 7 ) 

= 

ZINK 28) * RHU 

BENIN157 

RI (6,8) 


ZINK 2 7) * RHO 

BENI Nl 58 

R U 6 , 9 ) 

= 

Z I N T ( 2 5 I * RHO 

BEN I Nl 59 

R 1 ( 7 , 7 ) 


R 1 ( 6 , 8 ) 

BEN INI 60 

R 1 1 7,8) 

= 

R l ( 6 , 9 ) 

BEN1N161 

RI (7,9) 

a 

ZINK22) * RHO 

BENI N 1 62 

R 1 ( 8 , 8 ) 

a 

*117,91 

BENI Nl 63 

R 1 ( 8 , 9 ) 

= 

ZINK 18) * RHO 

BENI Nl 64 

RI ( 9,9 ) 

= 

ZINK 7) * RHO 

BEN I N 165 

DO 4b I 

a 

1,8 

BENIN 166 

II = I 

* 

1 

BEN I Nl 6 7 

CO 45 J 

a 

11,9 

BENIN168 

R 1 1 J , I ) 

= 

Kid ,j ) 

BENIN169 

DO 50 I 

:a 

1,9 

BENI Nl 70 

Df) 50 J 

= 

1,9 

BEN I Nl 7 1 

00 50 K 

• = 

1,9 

BEN INI 72 

R2( l ,J ) 

= 

R 2 ( I , J ) + ABN IT ( I , K ) * Rl(K,J) 

BE N l N 1 7 3 

DO 55 I 


1,9 

BEN I N 1 74 
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DO 55 J = 1,9 BENIN175 

DO 55 K * 1,9 BENIN176 

55 ELBIMt 1, Jl = ELBlMtl.J) + R2(1,K) * ABNI M ( K , J ) BFN1N177 

RETURN BENI N1 78 

END BEN I Nl 79 
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SUBROUTINE PRMT1 

PRINT GEOMETRIC BREAK-UP AND ASSOCIATED PROPERTIES 
COMMON 


PR INTI 01 
PRINT 102 
PR I NT 103 


l 


X ( 

100) , 

Y 

( 100) 

* 

Z 

( 100) , TH 

( 100) 

, PR I NT104 



XL ( 

100, 3) 

• 

YL ( 

100,3) , 


PRINT105 

RAP ANG ( 

50) , 

ZGL 

( 50) 

t 

RHUB 

( 50) , RTIP 

( 50) 

, PRINT 106 

THHUB ( 

50) , 

THIIP 

( 50) 

t 


EOCM 

I 3,3) 

t PR INT107 

RHO , 


PGISSO 

, YOUNGS 

. , RAOGEN , 


PR INTI 08 

NGENLI 

, LINE! 

» 



NEXT 

( 100,3) , NP , 

NT 

PR I NTI 09 


KOUNT 

WRITE 


- 0 

(6*5) 


XL 


5 FORMAT ( lHl/./3QX,29HRESULTlNG TRIANGULAR ELEMENTS ///) 

CO 20 I = 1 « NT 
WRITE 16, 10 ) 1 

10 FORMAT ( 35X, L2HELEMENT NO. *13,// 

1 20X, 67HNUDE NO. X Y l TH 

2 YL ) 

LA * NEXT! I, i) 

LB = NEXT ( 1,2) 

LC = NEXT* 1,3) 

WRITE (6,15) LA,X( LA) ,Y (L A ), Z( LA ) , TH( LA) , XL ( l , l ) , YL( l ♦ l ) « LB,X( LB) 

1 Y ( L B), Z ( LB), TH ( LB ) , XL ( I • 2 ) • YL (I ,2) , LC , X ( LC ) , Y ( LC ) , 

2 Z(LC) ,TH(LC) ,XL( I ,3) ,YL( I ,3) 

15 FORMAT ( 1 7X » 5HL A , I 3 , 5X , 3F 10 • 3 , 3F 10. 4/ 17X,5HLB 

l 3F10.4 / 1TX»5HLC , 13, 5X, 3F 10.3,3F 10. A// ) 

KOUNT = KOUNT + 1 

IF ( ( KCUNT .EQ. 7) .ANO. (I .NE. NT)) WRITE (6,5) 

IF ( KCUNT .EQ. 7 ) KOUNT = 0 
20 CONTINUE 
RETURN 
END 


PR I NT 110 
PR I NT ill 
PR I NT 112 
PR INTI 13 
PRINT! 14 
PR I NT 115 
PR I NT 116 
PRINT117 
PR I NT 118 
PR INTI 19 
PRINT120 
tPR'I NT 1 2 1 
PR I NT 122 
PR I NT 12 3 
t [ 3 , 5.X » 3F 1 0. 3 , PR I NT 1 24 
PRINT 125 


PR I NT 1 26 
PRINT127 
PR I N T 1 2 8 
PRINT 129 
PR I NT 130 
PR INTI 31 


175 



SUBROUTINE NORM ( ZOOS * I GEN i 

C CALCULATE NORM DIRECT I UN COSINE MATRIX AT EACH NODE • 

C 


COMMON X ( 

100 I 

* 

Y ( TOO) , Z 

( 100) , 

TH 

( 

100) 

l 




XL ( 100,3) , YL ( 

100,3) , 




2 

R A PANG ( 

50) 

r 

ZGL ( 50) , RHUB 

( 50 ) f 

RTIP 

( 

50) 

3 

THHUB ( 

50 ) 

» 

THTIP ( 50) , 


EOCM 

( 

3,3) 

4 

RHO , 



POISSO , YOUNGS , RADGEN , 




5 

NGENLI , 

LINE! 

, NEXT ( 

100,3) 

• NP , 

NT 

• 

6 

ELMSM ( 6 , 

6) , 

AMNI N (6,6) , E LBSM (9,9) 

, ABN I N t 9 , 9 ) 



7 

SIGMAX(IOO) , 

SIGMAYMOO) , ELSTIFU8 

• 18) , 




8 

TAUXYl 100) , 


ELSSM(9,9>, MEX ( 100 » 8 ) > IMEXUOO) , 



9 

EL INR ( IB 

, 18) 

* 

ELM I M ( 6,6) ,' E LB I M ( 9 , 

9) , ALE AN ( 50 ) 




D I MENS ION ZCOSUOO ) 

* 

IT (4) , I GEN (1001 






DIMENSION R 6 ( 18 

, 18 > 








CAT A R6 / 32 A *0.0 / 

EOCMU, 1 ) * 1.0 
EDCM ( 2 f l ) = 0.0 
FOCM( 3 t 1 ) = 0.0 
EDCMC 1,2) = 0.0 
EOCM( 1,31 = 0.0 
DO 40 I = 1 , N P 

I F { I ME X I I ) • N£ • 1 ) GU TO 15 
C POINT I IS COMMON TO ONLY ONE TRIANGLE . 

CO 10 J = 1,18 
00 5 K = 1,18 
5 R6 ( J, K ) = 0.0 

10 R6(J,J) = 1.0 

WRITE ( 3 * I > R6 
GO TO 40 

C POINT I IS COMMON TU MORE THAN 1 TRIANGLE . 

15 ITS = IMEX(l) 

KOUNT = 0 
DO 20 J = I, ITS 
Jl = M E X ( I , J ) 

IF { NEXT ( J 1 , 3) .60. I ) GO TO 20 
KUUNT = KOUNT ♦ 1 
I T I KOUNT I = ME X ( l, J) 

20 CUNTINUC 

Z NO = KOUNT 
ECCM (2,2) = 0.0 
EDCM (2,3) = 0.0 
Oil 25 J - l , KOUNT 
Jl = ITT 4 1 

25 EDCM (2,2) = €CCM(2,2) ♦ ARCOSl ZCOS(Jl) ) 
EDCM (2,.?) EDCM (2,2) / /NO 
EDCM l 3,3) = EDCM (2, 2) 

CO 30 J * 1,3 
CO 30 K = 1,3 
R 6 ( J , K ) = EDCM ( J , K ) 

R6 ( J*3 , K + 3 ) = EDCM ( J , K ) 

R6 ( J + 6 , K *6 ) = EDCM ( J , K ) 

R6 ( J *9 , K + 9 ) = EDCM ( J , K ) 

R 6 ( J + 12,K + 12) = EDCM(J,K) 

3C K M J ♦ 1 5 , K ♦ 1 5 ) = F DCM ( J , K ) 

WRITE (HI) R6 
40 CUNT J NUC 
RE ! UR V 


NORMOOO 1 
NORM0002 
NORMOOO 3 
,NQRM0004 
N0RM0005 
, NQRM0006 
,NORM0007 
N0RM0008 
NORM0009 
NOR MOO 10 
NQRM001 1 
NORM0012 
NORMOOL3 
NORMOQ14 
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FIND 


N0RM0420 
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SUBROUTINE ASSEMK ( ZOOS , IPOS ) 

transform stiffness matrices tu normal systems and assemble 

INTO A I3N X 3N ) MATRIX . 


ASSEK001 

ASSEK002 

ASSEK003 

ASSFK004 


COMMON 

X ( 

100) , 

Y ( 

100 ) , z 

( 100) 

, TH I 100) 

, ASSE K005 

1 



XL ( 100,3) , YL t 

100,3) 

, 

ASSEKO 06 

2 

RAPANGt 

50) , 

ZGL ( 

50) , RHUB 

( 50) 

, RTIP | 50) 

, AS SEKOO 7 

3 

T HHUB T 

50) , 

THTIP ( 

50) ., 


EDCM ( 3,3) 

, ASSEKO 08 

A 

RHO , 


POISSU , 

YOUNGS , RAOGEN , 


ASSEK009 

5 

NGENL I , 

LINE! 

9 

NEXT ( 

100,3) 

, NP , NT , 

ASSEKO 10 

6 

ELMSM ( 6 , 

6) , AMN I N ( 6 » 6 ) 

, ELBSMT 9,9) 

, ABNlN ( 9 , 9 ) , 

ASSEKO 11 

7 

SIGMAX(IOO) , SIGMAYtlOO) , EL ST I F 1 1 8 

,18) , 


ASSE KOI 2 

8 

TAUXYT 100), 

EL SSM ( 9, 

9), MEXT LOG, 8), IMEXUOO), 

ASSEKO 13 

9 

EL INK ( 18, 18) 

t 

ELMIM(6,6) 

, E L 8 1 M ( 9 , 9 ) 

ASSEKO 14 

DIMENSION ENST IF (9 ,9) 

• 

R6( 1 8 , 

18) , AM SO, 50) , 

ASSEKO 15 


BK (100,100) 
R 1 T 18,18) , 


, CK ( 100, SO ) 
ZCOST ICO) 


IPOSUOOI , MEXT ( 8 ) , 


lu 


N = NP - NGENL I 
KOUNT = 0 
00 55 I = l,NP 

IF ( iPnS(I) ,LT, 0 ) GO TO 55 
KOUNT = KUUNT ♦ 1 
IMEXT = l M E X ( I ) 

DO 10 J = 1, IMEXT 
MEXT ( J ) = MEX( I,J) 


I NO I 9 ) , ASSEKO 1 6 
ASSEKO 17 


DATA 

IN. 

/ 9, 15, A i 10, 16, 5, 11, 17 / 

ASSEKO 18 

DO 1 

I = 

1,50 

ASSEKO 19 

DO 1 

J = 

1,50 

ASSEK020 

AK ( I , 

J) 

= 0.0 

ASSEK02 1 

CK( I, 

J) 

* 0.0 

ASSEKO 2 2 

CK ( 1 + 

50, 

J) = 0.. 

ASSEKO 2 3 

DO 2 

I = 

1,18 


DO 2 

J = 

1,18 


R6( I, 

J) 

= 0.0 


DO 5 

I = 

it 100 


DO 5 

J = 

1,100 


BK ( I , 

J) 

= 0.0 



ASSEK024 
ASSEKO 2 5 
ASSEK026 
ASSEKO 2 7 


00 50 J = L, IMEXT 

ASSEK028 

K2 = MEX T ( J ) 

ASSEK029 

FINO ( 1 * K 2 i 

ASSEK030 

LA = NEX T ( K2 , 1 ) 

ASSEKO 31 

LB * NEX T ( K2 , 2 ) 

ASSEK032 

LC = NEXT (K2, 3) 

ASSEK033 

NA = I PUS (LA) 

AS5EK034 

N8 ~ I POS (LB) 

ASSEKO 35 

NC = IPOS ( LC ) 

ASSEKO 36 

READ ( 1 * K 2 ) EL ST IF ,EL l»NR , EDCM 

ASSEKO 37 

FIND ( 3* I ) 


IF ( LA .ED. I ) I NO 1 - 1 

ASSEKO 3 8 

IF ( LB • FQ • 1 ) I 'iDl = 2 

ASSEKO 39 

IF ( LC .EC* I ) I NO l = 3 

ASSEKO AO 

RF AD (3*1) R6 


IF ( IMEXT .EC. 1 ) GJ TO 17 


J 1 = M EX T ( J > 


96(3,2) * SINT R6(3,3) - ARCUSt ZCOSTJl) ) ) 


R 6(3,3) = COS( R6( 3, 3 ) - ARCUST ZCOST J l ) ) ) 


R6 ( 2 , 2 ) = R6( 3, 3) 


R 6 ( 2 , V) = -R 6 ( 3,2) 




DO 15 K = 1,3 
DO 15 L = 1,3 
R.6C.K + VL+3.) - R 6 ( K , L ) 

R6(K+6,l+6) = R6(K,L) 

R6 ( K+9 , L +9 ) “ R6(K,L) 

R6 ( K+ 12, 1 + 12 ) = R6( K,L ) 

15 R6 ( K + 1 5 , L + 1 5 ) = R6 ( K ,L ) 

17 00 20 K = l, 18 

DO 20 1 = 1,18 
R 1 ( K , L ) = 0.0 
CO 20 M = l, 18 

20 Rl(K,L) = KlIKrll ♦ R 6 1 K , M ) * EtSTIF(M,U 
DO 25 K * 1,9 
DO 25 L * 1,9 
ENST IF ( K , L ) = 0.0 
DO 25 M = 1,18 

25 ENST IF 1 K , L ) = ENST I F ( K , L ) ♦ Ri(lND(K),M) * R6IIND(L),M) 

IF I l POS (LAI .IT. 0 ) GO TO AO 

AK (KOUNT , NA+ 1 ) = AK ( KOUN T, NA+ 1 ) + ENST I F (I NDl , 1 ) 

CK{ KUUNT , NA+ 11 = CK (KOUNT, NA+1) ♦ ENST IF ( I NO l +3 , i ) 

CK(KQUNT+N,NA+i ) * CKIKOUNT+N, VA+t ) ♦ ENST IF ( IN01 + 6,U 

0K (KOUNT , N A+ l ) = BK ( KOUNT , NA> 1 ) ♦ ENST I F ( 1 NO 1 + 3 , A) 

BKIKOUNT ,N+NA+1) * BK ( KOUN T , N+NA+ 1 ) ♦ ENSTI F ( I NO U3 , 7 ) 

BK(KOUNT+N,NA+i) = BK (KOUNT +N,NA* 1 ) + ENSTI F (I NDl +6 , A) 

BK ( KOUNT +N , N + NA + 1 ) = BK ( KOUNT +N, N+NA+ 1 ) .♦ ENST IF ( I NO 1 + 6, 7) 

AO IF ( I POS (LB) .IT. 6 ) GO TO A 5 

AK ( KOUNT , NB + 1 ) = AK ( KOUNT , NBt'l ) ♦ ENST I F ( I NDl , 2 ) 

CM KOUNT , NB + l ) = CK ( KOUNT ,NB + 1 ) + ENST I F ( I NDl +3 , 2 I 

CM KuUN T +N ,NB+ 1 ) = CK ( KOUNT +N, NB+ 1 ) + ENST IF ( I N01 + 6, 2 ) 

BK( KOUNT ,NB> 1 ) = BKIKOUNT, NB + l ) * ENST1F i INDl+3,5) 

BK ( KOUNT , N ♦N B + 1 ) = BK ( KOUNT , N+NB+l ) ♦ ENSTI F ( I NDl + 3 , 8 ) 

BK ( KOUNT +N, NB + 1 ) = BK ( KUUN T+N , NB ♦ i ) + ENST I F ( I NDl + 6 , 5 ) 

BK(KDUNT>N,N + NB+1) = BK ( KOUN T+N , N+NBt 1 ) ♦ ENSTI F ( I NO 1 + 6,8) 

A 5 IF ( IPOS(LC) .LT. 0 ) GO TO 50 

AM KOUNT ,NC+ 1 ) * AK ( KOUNT , NC + 1 ) + ENSTI F ( I NDl , 3 ) 

CK ( KOUNT , NC* 1 ) - CK (KOUNT, NC+1 ) ♦ ENSTI F ( IND1+3 , 3) 

CK(KUUNT+N,NC + 1 ) = CK ( KOUNT* N, NC + 1 ) ♦ ENS T I F ( I ND1+6 , 3 ) 

BKIKOUNT, NC*l ) - BK (KOUNT , NC> 1 ) + ENST I F ( I N01 ♦ 3 ,6 ) 

BKIKOUNT, N+NC+1 ) = BK ( KOUN T , N+NC + 1 ) ♦ ENST IF ( I NO 1 + 3, 9 ) 

BKIKOUNT +N , NC * 1 ) = BK ( KOUNT *N , NC + 1 ) + ENSTI F (I NDl +6, 6) 

BK ( KOUNT +N , N +NC + 1 ) = BK ( KOUNT+N, N*NC* 1 ) * ENS T I F ( I NO 1 + 6, 9 ) 

50 CONTINUE 
55 CONTINUE 

WRITE 12*1) ( ( AK ( I , J ) , J=1 ,50 ) , I -1 , 1 7) 

WRITE (2*2) ( (AK(I,J),J=i,50),I=18,3A) 

WRITE (2 * 3 ) ( ( AK (I , J ), J = 1, 50 ) , 1 = 35,50) 

Kl = -8 
K 2 = 0 

DO 60 K = 1,11 
Kl = Kl + 9 
K 2 = K 2 ♦ 9 
L = K + 3 

60 WRITE ( 2 • L ) ( ( BK ( I , J ) , J = i , 1 00 ) , I = K 1 , K 2 ) 

WRITE (2*16) ( HK( 100, J ) , J=l, 100) 

Kl = - 8 
K.2 = 0 

Du 65 K = 1,5 
Kl = Kl ♦ 9 
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ASSEK061 
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K2 = K2 + 9 ASS EK 106 
L = K ♦ 15 ASSEK107 
WHITE ( 2 * L ) ( (CK ( 1 1 J ) » I = l > 100 ) » J=K 1 » K2 ) ASSEK108 
WRITE (2*21) IICKU , J) , 1=1, ICO), J-A6,50) ASSEK109 
RETURN ASSEKiiO 
END ASSEKlil 



| sO CD *4 O" U1 W (S) ♦— 


JL. 

C 


SUBROUTINE ASSEMM l„ZCOS_, IPOS ) 

transform inertia matrices to normal systems and assemble 

INTO A ( 3N X 3N ) MATRIX . 

* __ 

COMMON X t .1QP l , Y J lOOK , t _ T lOO) , TH ( 100) 


L 

100) , Y 

( 100) , 

Z 

( 100) 

, TH 


XL I 

100,31 t 

Yl < 

100,3) 

t 

I 

50) , ZGL 

( 50) , 

RHUB 

< 50). 

, RTIP 

( 

50) , THTIP 

( 50) , 



EOCM 


RAPANGI 
THHUB ( 

RHO 

NG ENLI , LINE I 


50) 

3,3) 


POISSO , YOUNGS , RAOGEN , 

NEJCJL.L 100,3) 


NP , NT 


01 MENS ION 


ELMSMC 6,6) , AMNI N( 6,6) , ELBSM(9,9> , ABNlNC 9,9 ) , 
SIGMAXUOO) , SIGMAY (100) , ELSTIF ( 18, 18 > , 

TAUXY(iOO), ELSSMC 9,9) , MEXC 100,8), IMEX(IOO), 

ELI NR (18,18) , _ ELMIMC6 ,6 ) , ELBIM(9,9) 


ENINR(9,9) 



2 


IND( 9 ) , R1 (18,18 


DATA 

I ND 

/ 3, 9, 15, 4, 10, 


DO i 

I = 

1,50 


DO 1 

J = 

1,50 


AM( I t 


= 0.0 


CMC I, 

,J) * 0.0 


, R6( 18,18) 
, IPOS (100) 


AM( 50 , 50 ) 
MEXTC8) , 


i , ZCOS(IOO). 
16, 5, 11, 17 


1_ CM ( 1+50 • = 0.0 
00 2 I = 1 , 18 
DO 2 J = iilB 
l R6U,j) =_0.0 

_ DO. 5 1= U100_ 

00 5 J * 1 ,100 


BMC I , J ) = 0.0 
N = NP - NGENLI 
KO UNT =0 


DO 55_I_ =_ LrNP 4 
IF ( _IPQS( I ) .LT • 0 
KOUNT = KOUNT + 1 __ 


) GO TO 55. 


mEXT_*_JLMEX,U.l 

_D0 10 J = 1 , 1MEXT 
16 MEXT(j) r_ MJE X ( I , J ) 

DO 50. J_* 1 , I ME XT 

_ K2_= MEXJJJ) 

F IND ( I * K2 ) 


LA .* N EXT! K2. 1 ) 

LB =„NEXT(K2,2J 

_LC _=„NEXtcK2 j 3) 

NA _= JPOSILAI 

N B ® IPOS (.LB.) 

NC = IPOS (LC ) 


READ_(_1*K2) ELSTLFiELINRjfEDCM 

FIND (J* I) 

i_E_ I_ LA _.EQ« L > IND1 * 1 

IF_LUS„__ • ELQ « L. J_ . XND l = 2. 

- _ IF ( LC . EQ. I ) I ND 1_=_ 3 
READ (lill R6 


IF ( I ME XT .EQ. 1 ) GO TO 20 


J1 * M EXT(J) 


R6( 3, l l_=_Sl_N(_R4( 3i3 J.r_ ARCQSA ZC0S1JU X )_. 
R6( 3, 3 ) * COS( R 6 ( 3 , 3 ) - ARCOSC ZC0S CJ1) ) ) 
R6 ( 2,2) = R6 ( 3t 3 ) 

R6( 2,3) = — R6 (3,2) 
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CO 15 K * 1*3 
DO 15 L = 1*3 
R6(K+3,L+3) = R6(K,L> 

R6 ( K+6 * L +6 ) = R 6 ( K , L ) 

R6(K+9,L+9) = R6 (K , L ) 

R6(K + 12,L + 12 ) = R6 (K , L ) 

15 R6<K+15,L+15) = R6(K,L) 

20 DO 30 K - 1*18 
CO 30 L :» l* 16 
R1(K,L) = 0.0 
DO 30 M - 1*18 

30 R 1 ( K v L ) = R 1 ( K , L ) + R6(K,Mi * EL I NR ( M , L ) 

DU 35 K = 1,9 
DO 35 L = 1,9 
ENI NR ( K , L ) = 0.0 
DO 35 M = 1,18 

35 EN l NR( K, L ) = EN INK ( K ,L ) + R1UND(K),M) * R6(IND(L),M) 

IF ( I PO S (LA) .LT. 0 ) GO TO 40 

AM( KUUNT ,NA+ 1 ) = AM ( KOUMT , NA + 1 ) + ENI NR < I NO l * 1 ) 

CM(KOUNT,NA+l ) = CM ( KOUNT , NA + 1) + FN1 NR (INDl+3 * 1 ) 

CM(KOUNT+N,NA+i > = CM ( KOUN T+N , NA + 1 ) + ENI NR ( IND1 +6 , 1 ) 

BMC KOUNT ,NA + 1 1 = BM (KOUNT ,NA + i ) + ENI NR ( 1 ND l + 3*4 1 

BM( KOUNT ,N+NA+l ) = BM ( KOUNT , N+NA+ 1) + EN I NR ( IND l + 3 * 7 ) 

BM{ KOUNT + N,NA + l ) = 0M (KOUNT+N, NA+ l ) + ENI NR (I NO l + 6*4 ) 

BM( KOUNT +N, N+NA + 1 ) = BM ( KOUNT+N ,N+NA+ i ) + ENI NR ( IN01+6 , 7.1 

40 IF ( IPOS(LB) .LT. 0 ) GO TO 45 

AM( KOUNT ,NB+i ) = AM ( KOUNT , NB+ l ) + EN I NR ( I ND 1 , 2 ) 

CM( KOUNT, NB+1) = CM (KOUNT *NB + 1) + ENI NR U NO 1 +3,2 ) 

CM (KOUNT +N,NB+i ) = CM( KOUNT + N, NB + 1) + ENI NR ( IN01+6 , 2 ) 

BM ( KOUNT , NB+ 1 ) s= BM (KOUNT , NB + 1 ) + ENINR ( I NO 1 + 3* 5 ) 

8M( KOUNT *N+NB + 1 ) = BM ( KCJUNT, N+NB+ 1) + EN INR (I NO i + 3, 8 > 

BM( KOUNT +N, N8 + 1 ) = BM ( KOUNT +N,NB + l ) + ENI NR ( lNDl+6,5) 

BM ( KOUNT +N,N+NB+ 1 ) = BM ( KOUNT + N , N + NB+ 1 ) + ENI NK ( I NO l +6 , 8 ) 
45 I F ( I POS( LC ) . L T. 0 ) GO TO 50 

AM( KUUNT ,NC + 1 ) = AM ( KOUN T , NC + 1 ) + ENI NR ( I NO l * 3) 

CM( KOUNT , NC+ 1 ) = CM ( KOUNT ,NC + 1 ) + EN I NR ( I ND 1 +3 , 3 ) 

CM { KOUNT +N,NC + 1> = CM( KOUNT + N , NC + 1 ) + ENI NR ( I N01 +6 , 3 ) 

BM ( KOUNT , NC+ 1 ) = BM l KOUN T , NC + 1 ) + EN I NR ( I NO l + 3 , 6 ) 

BM( KUUNT, N + NC + 1 ) = BM ( KOUNT , N+NC+ l J + EN I NR ( I NO 1 + 3 , 9 ) 

BMC KOUNT+N, NC+i ) = BM ( KOUN T +N , NC + 1) + ENI NR (I NO 1 +6,6 ) 

BM ( KUUNT +N , N +NC+ l ) = BM ( KOUNT + N , N + NC + 1 ) + ENI NR < END l +6 ,9 ) 

50 CONTINUE 
55 CONTINUE 

WRITE (2*22 M ( AM(I,J J,J*i,50), 1=1, 17) 

WRITE ( 2*23) ( (AM( I, J ),J = 1, 50) ,1 = 18,34) 

WRITE ( 2 • 24 ) { (AMT I , J ) » J = l , 50 ) » 1 = 35,50) 

K 1 = -8 

K2 = 0 

CO 60 K = 1,11 
K 1 = Kl + 9 

K2 = K 2 + 9 
L = K + 24 

60 WRITE ( 2 * L :) ( ( BM ( I , j ) , J = 1,100) ,l=Kl , K2 ) 

WR I TE 12 ' 36 ) ( HM ( 1 00 , J ) , J = l , 100) 

K 1 = —8 
K'2 = 0 

CU 65 K = 1,5 

Kl = Kl + 9 
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K? = K2 + 9 ASSE Mi 06 

L - K ♦ 36 ASSEM107 

66 WRITE 12«L> UCMU , , 1*1, 100) , J=K1 ,K2) ASSEM108 

WRITE (2*42) f (CM( I, J),I*1, 100 ) , J*A6, 50 1 A55EM109 

RETURN ASSEMliO 

END ASS E Mi i I 
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SUBRUUT I NC REOUCMN) 


REDUCKOi 


REDUCE THE ASSEMBLED STIFFNESS MATRIX TO 

AN (N X H) MATRIX. 

REDUCK02 




REDUCK03 


DIMENSION AKL50, 50)t BK 1100,100), CKIIOO, 

50 ) , SK I 5 0,50 ) , R 1 1 50 , 

100REDUCK04 

1 ) 


REDUCK05 


EQUIVALENCE I AK (1,1), SK(lill) 


REDUCK06 


DATA R l / 5000 * 0.0 / 


REDUCK07 


READ 12 M) ( ( AK( I , J ) , J = 1 , 50 ) , I = 1 , 17) 


REDUCK08 


READ 12*2) UAKU ,J ) ,0*1,50 ) , 1=18,34) 


RE0UCK09 


READ (2*31 {(AK(I,J),J=1*50) , I = 35 , 50! 


RE DUCK 10 


K 1 * -8 


REDUCK 1 1 


K2 = 0 


REDUCK 12 


CO i K = 1,11 


RE DUCK 13 


Kl = Ki +9 


REDUCK 14 


K2 a K2 + 9 


REDUCK15 


L = K + 3 


REDUCK16 


READ t 2 * L ) ( ( 8K ( I ,J) , J = 1,1 0 0 ) » I =K 1 , K2 ) 


REDUCK 17 


READ (2*15) (BKMOOtJ)t J-ltlQO) 


REDUCK 18 


Kl a -8 


REDUCK19 


K2 = 0 


REDUCK20 


DO 2 K = 1,5 


REDUCK21 


Kl a Kl + 9 


REDUCK22 


K2 a K2 + 9 


REDUCK23 


L = K + 15 


REDUCK24 


READ ( 2 1 L ) ( ( CK ( I , J ) , I = 1 , 100 ) , J=K 1 ,K2 ) 


REDUCK25 


READ ( 2 ’ 2 1 ) ( (CKU,J), 1 = 1,100), Ja46, 501 


REDUCK 26 


N2 a 2 * N 


REDUCK2 7 


DO 30 K = 1 , N2 


REDUCK28 


IF (OKI*, Kl) 15,5, 15 


RE DUCK 29 

5 

WRITE (6,10) 


REDUCK 30 

10 

FORMAT ( 52H 8 PORTION OF ASSEMBLED STIFFNESS MATRIX IS SINGULAR 

) REDUCK31 


WRITE (6,12) ( ( 8K ( I , J ) , J = 1 , N 2 ) , I = 1 , N 2 ) 


REDUCK32 


FORMAT ( 10E12.4) 


RE0UCK33 


N = -N 


REDUCK 34 


return 


RE0UCK35 

15 

X = 1.0 / BK ( K , K ) 


REDUCK36 


BK(K,K) = 1.0 


RE0UCK37 


DO 20 J = 1 ? N 2 


REDUCK 38 

2 0 

B K ( K , J ) = BK ( K , J ) * x 


REDUCK39 


IF (K - N2) 25, 35, 25 


REDUCK40 

25 

M = K + 1 


REDUCK4 1 


DO 30 I = M, M2 


REDUCK42 


X = bKII ,K) 


REDUCK43 


BK ( I , K ) a 0.0 


REDUCK44 


DO 30 J = t , N 2 


RE0UCK45 

30 

BK { I , J ) = BK ( 1 , J ) - X * B K ( K , J ) 


RFDUCK46 

35 

LL = N.2 - 1 


REDUCK47 


DO 40 1=1, LL 


RFDUCK48 


M = l ♦ 1 


REDUCK49 


DU 40 K = M, N2 


RE DUCK 50 


X a ftKt t , K ) 


REDUCK51 


8K( I ,K) = 0.0 


REDUCK52 


CQ 40 J = 1, N 2 


REDUCK53 

40 

BK1|,J) = BK ( 1 , J ) - BK I K , J ) * X 


REDUCK 54 


DO 45 I = i * N 


REDUCK55 


GO 45 J = 1,»M2 


REDUCK56 


CO 45 K = 1 , N2 


REDUCK57 

4 6 

R l ( I , J ) = R l (I , J ) + CK ( K , I ) * BK ( K , j ) 


RE DUCK 58 
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00 50 I * 1 » N 
00 50 J = l,N 
00 50 K = 1 f N2 

50 SK ( I * J J = SKtUJI - K l ( l » K ) * CK(K»J) 
WRITE 12*1) { (SK( I 9 J )»J=l»50)fI=i* 17) 
WRITE (2*2) { ( SK l 1» J ) * J = l * 50 ) * I = 18 » 34 ) 
WRITE (? • 3 ) ( ( SK { I » J ) t J = 1* 50 ) 1 1 = 35 *5-0 ) 
00 55 | * l f M2 
00 55 J « 1 » N 

Riu.n * o.o 

DO 55 K = I ♦ N2 

55 Rl(J,n = Rl(J,I) ♦ BK ( I *K ) * CK(K,J> 

K I = -8 
K2 * 0 

DO 60 K - 1 1 5 
KL * Kl + 9 
K2 = KZ + 9 
L * K ♦ 42 

60 WRITE {2*U ((Rl(I,JltJ=itl001.l*Kl,K2) 
WRITE (2 *48) ( (RUT 100) f 1*46,50) 

RETURN 
EMC 
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SUBROUTINE REDUCMC N) 

REDUCE THE INERTIA MATRIX TO AN IN X N) MATRIX. 

1 DIMENSION AM_(50,50), BMC 100,100), CMC 100*50) , SM(50,50) 
1)_ 

EQU I VALENCE ( AM ( I , I) * SM ( I » 1 )) 

OATAJU >__5000 * 0.0 / 

READ .(2*221 C I AM C I , J ) , J=1 * 50 ) , 1 = 1 , 1 7 ) 

READ C 2 * 2 3 ) ( ( AM C I , J ) , J=l » 50 ) , 1 = 18 * 34 ) 

_READ _ « 2 •_ 24.) I ( AM ( I , J ) , J = 1 * 50 ) * 1*35 * 50 ) 

K 1 ._= -8 . 

K2__= 6 

DO 1 K = i f ii 
K 1 - K 1 ♦ 9 

K2 = K2 +9 

L = K + 2 4 

1 READ <2*L) ( CBMCt ,J )t J=ItlOO) ,i=Kl,K2) 

READ_ ( 2 9 3 6 ) (BMC ICO* J ) , J=l *100) 

kL = -8 

K2 = 0 

D0_ 2 K = 1,5 

JU_^K1_ +_9 __ _ 

K2 * K2 ♦ 9 

L = K + 36 

2 R E AD ( 2 9 L ) ( (CMC I , J ) * 1=1 ,100) ,J=K1, K2~ ) 

READ ( 2 9 42) U CM C I , J ) , 1 = 1 * 1 00 ) * J=46 * 50) 

Kl _= -8 

_ _ K,2 = 0 

D0_ 3 K = 1,5 

Kl *_K1 ♦ 9 

_ _ K2 = K2 + 9 

L = K + 42 

3 READ ( 2* LI ( C R1 ( J , I) , J=1 *100) , I = K1 » K2 ) 

READ _C 2^48 ) t (_R1 ( J* l ) * J=1 *100 ) * 1=46 *50) 

N2 = 2_ * N 
DO 4 I = 1 ,N2 
_ DO 4_ J = I*N 
DO 4 K = 1 , N2 

4_ CMU_,J) = CM C I , J ) - BMC 1 , K ) * R1(K,J) 

DO 5 1 = 1 , N 

DO 5 J = l *N 
DO 5 K * I * N2 

5 $M ( I * j ) = SMC I, J) - R l ( K , I ) * CM { K * J ) 

Kl = —.8 

_ _ K2 • 0 

00 6 K = 1,5 _ _ 

Kl = Kl + 9 
K2 = K2 -5- 9 
L j* K 4 36 

6 READ ( 2 9 L ) ( (CMC I, J) *1-1*100) ? J= K 1 , K2 ) _ 

READ (.2*421 C (CMC I ,J) ,1=1,100) , J=46, 50) 

. DO 7 1= 1* N _ . 

_____ DO 7_ J = i,N 
DO 7 K = 1,N2 

7 SMC I, J) = SMC I, J) - CM C K * I ) * R1(K,J) _ 

WRITE ( 2*43) < C SMC I f J)*J=l* 50), 1=1*17) 

WRITE ( 2 » 4 4 ) ( ( S M ( I * J ) * J = 1 , 5 0 ) , I = 1 8 , 3 4 )_ 

WRITE (2*45) C (SMC I,J) , J = 1 * 50 ) * 1 = 35 ,50) 


REDUCM01 
REDUCM02 
RE0UCM03 
R1 ( 100* 50REDUCM04 
REDUCM05 
REDUCM06 
REDUCM07 
REDUCM08 
RE0UCM09 
REDUCM10 
REDUCMl 1 
REDUCM12 
RE DU CM i 3 
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REDUCM39 
REDUCM40 
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R FT URN 
END 


RE0UCK59 

RE0UCM60 
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SUBROUTINE EIGEN I N, OMEGA ) 

SOLVE FOR THE NATURAL FREQUENCIES. 

DOUBLE PRECISION CUEF, E I GVR « EIGVI 

DIMENSION SK ( .50 » 50 ) , SM( 50,50), OMEGAI50), C0EFI50,50) 
I E I GV I { 50 ) • FR EQ I 50 ) 

DATA COEF , EIGVI , EIGVR / 2600 * 0.000 / 

READ 12* l I ( (SKI ! • J >, J = l, 501* 1=1 t 17) 

READ (2*2) ( ( SKI 1 , J ) , J = 1 , 50 ) * 1=18,34) 

READ (2 1 3 ) ( (SKI i , J ) , J s 1 , 50) » I - 35 , 50 ) 

READ (2 *43 ) ( ( SM I I * J ) , J=1 , 50) * 1*1 #17) 

READ (2*44) ( (SH.CI » J), J=i,50), 1*1.8,, 34) 

READ ( 2 * 4b M ( SMI I , J ) ,J-*1 , 50 ) , 1 = 35,50) 

DO 30 K = l , N 
IF ISHLKfK ))15, 5, 15 
5 WRITE ( 6 , 10) 

10 FORMAT ( 3 5 H REDUCED INERTIA MATRIX IS SINGULAR ) 

N * -N 
RETURN 

15 X = 1.0 / SM(K,K) 

SMIK.K) = 1.0 
CO 20 J = 1,N 
20 SM(KfJ) = SM l K , J ) * X 
IE (K - N) 25, 35, 25 
25 M = K ♦ i 

CO 30 I = M , N 
X = SM( I , K ) 

SM(I,K) = 0.0 
DO 30 J = i,N 

30 S M ( I , J ) = SMI I i J ) - X * SMI K , J ) 

3b LL = N - L 

DO 40 I = l,Ll 
M = I + 1 
CO 40 K = M, N 
X = SM I I ,K ) 

SMI l , K ) = 0.0 
CO 40 J = i,N 

40 SMI I, J) = S M I I , J ) - SM ( K , J ) * X 
DO 45 l = l,N 
DO 45 J = l,N 
DO 45 K = 1,N 

45 COE FI I, J ) = COEF I I , J ) + SKM,K) * $M(K,J) 

M = N 

CALL CIG3 (CUEF, N , M, EIGVR, EIGVI) 

K0UN1 - U 
CO 50 I = 1 , N 

IF ISNGL (EIGVI { I ) ) .NE. C.D) GO TO 50 
IF ( EIGVR (M .LT. 0.000 ) GO TO 50 
KOUNT = KOUNT ♦ 1 

SIGNS = 1.0 

OMEGAIKOUNT ) = SIGNS * DSQRTt DABS ( E l GVR I I) ) ) 

FKFC(KCUNT) = uMEGA.il KOUN T ) / 6.283185 
50 CONTINUE 

IF IKCU4T .GT. 0) GO TO 60 
N * - N 


EIGENOOO 
EIGEN001 
EIGEN002 
EIGEN003 
E IGVR I 50 ) ,E I GEN004 
E IGEN005 
EIGEN006 
EIGEN007 
EIGEN008 
EIGEN009 
El GENO 10 
El GE NO 11 
El GENO 12 
E I GENO 13 
El GENO 14 
El GENO 15 
El GENO 16 
El GENO 17 
El GENO 18 
El GENO l 9 
El GENO 20 
El GENO 21 
El GENO 2 2 
El GENO 2 3 
EIGEN024 
ET GENO 25 
El GENO 2 6 
£ I GE NO 2 7 
El GENO 2 8 
E I GENO 29 
El GENO 30 
EIGEN031 
E I GENO 3 2 
EIGEN033 
El GENO 34 
EIGEN035 
E I GENO 3 6 
EIGEN037 
E l GENO 38 
£ I GENO 3 9 
EIGEN040 
E I GENOA 1 
El GENO 42 
EIGEN043 
EIGEN044 
EIGEN045 
El GENO 46 
EIGEN047 
EIGEN048 
EIGEN049 
El GENO 50 
E I GENO 51 
EIGEN052 
8 I GENO 5 3 
EIGEN054 


WRITE 16,55) EIGEN055 

55 FORMAT I 49H ALL CALCULATED FREQUENCIES ARE IMAGINARY NUMBERS ) EIGEN056 


R F T URN 


E I GEN057 
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60 WRITE (6,65) ( FREQ ( KQUNT + 1” I ) , I = l »KUUNT ) 

65 FORMAT { 1-Hit A/ 40X, 19HNATUR At FREQUENCIES / / ( 43 X f E12.5 
N = KOUNT 
RETURN 
END 


EIGEN058 

EIGEN059 

ETGEN060 

E1GEN061 

EIGEN062 
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o o r> non 


SUBROUT I N't LAGER.* A , EPS , N 1 ,NU ,N ,RTR ,RT I ) 
IMPLICIT REALMS ! A-H, U-Z ) 

D I MENS ION A! SOt 50),Pl 6 t 101) 

D I MENS ION RTKI50I ,RTII 50) »B (6) 

REAL SSSSSS 

C **** DOUBLE PRECISION LAGER **** 

ONCE=O.G 
DATA X / 0 • ODO / 

DATA Z / 1.000/ 

8L 1 = 1 *0 
NUC-NU- 1 
LL Y=0 

DE LOLD= 1 .0 
ROLD= 1 .0 
EGSUM 1=0.0 
EGSUM2=0 .0 
DO 10 L = 1 « 6 
DO 10 LL X= 1 * 101 

10 P.( L * LLX 1=0.0 
NU1=NU*1 
CUP=0.0 

DO 11 J- NU1 > N 

11 CUP = CUP + DABS t A l J - l , J ) ) 

If (N .ME . NU) GO TO 200 
CUP = 0. 

GO TO 201 

200 CUP=CUP/DFLOAT ( N-NU ) 

201 C AP = 0 • 

PM # NU 1 = 1.0 

FIND TRACE OF H AND H SQUARED 

SPUR l = A ( NUtNU) 

S PU R2 = A I NU f NU ) * * 2 
DO 13 J=NUl,N 
SPURl*SPUR UA( J, J) 

13 SPUR2 = SPUR2 + A ( J , J ) **2+2. ODO* A ( J-l , J )*A ( J , J-l ) 
INITIAL ITERATE FROM INFINITY 

14 SIR-EGSUMl-SPURl 
S2R=SPUR2-EGSUM2 
F 1 =N— NUQ 

I F { DABS (SIR) + DABS! S2R ) -l.D-7*CAP) 15»15,16 

15 XRAR=CUP 
YRAR=0.0 
GO TO 23 

Ifc F2 = F l - 1 . ODO 

DR = F2 * ( F l * S2 R-S 1 K**2 ) 

ER = DSCRT ( DABS ( DR ) ) 

IF! DR) 1 7, 18, 18 

17 IF! FI »NE • 0*000) GU TO 202 
X B AR = 0 . 

Y8AR~0. 

GO TO 23 

202 X BAR--2 . ODO* S IK / F I 
YBAR=2.0D0*ER/f 1 
GO TO 23 


LAGR0010 
LAGR0020 
LAGR0030 
LAGR0040 
LAGR0050 
LAGR0060 
LAGR0070 
LAGR0080 
LAGR0090 
LAGR0100 
LAGRO 1 10 
LAGROl 20 
LAGR01 30 
LAGR0140 
LAGRO 150 
LAGRO 160 
LAGROl 70 
LAGROl 80 
LAGROl 90 
LAGR0200 
LAGR0210 
LAGR0220 
LAGR0230 
LAGR0240 
LAGR0250 
LAGR0260 
LAGR0270 
LAGR0280 
LAGR0290 
LAGR0300 
LAGR03 10 
LAGR0320 
LAGR0330 
LAGR0340 
LAGR0350 
LAGR0360 
LAGR0370 
LAGR0380 
LAGR0390 
LAGR0400 
LAGR0410 
LAGR0420 
LAGR0430 
LAGR0440 
LAGR0450 
L AGR0460 
LAGR0470 
LAGR0480 
LAGR0490 
L AGR0500 
LAGR0510 
LAGR0520 
LAGR0530 
LAGR0540 
LAGR0550 
LAGR0560 
LAGR0570 
LAGR0580 
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n o o o o o 


1H 

Y BAR-0 #0 

LAGR0590 


S1RX=S LR 

LAGR0600 


F2 = CSIGN1 1.000, S1KX ) 

LAGR06I0 


IFIS1R)22,20,22 

LAGR0620 

20 

F2-G *0 

LAGR0630 

22 

I F t F 1 -NE • 0*003 ) GO TO 2 03 

LAGR0640 


X B AR = 0 • 

LAGR0650 


GO TO 23 

LAGR0660 

203 

XBAR= “(S1R+F2*ER)/F1 

LAGR0670 

LAGR0680 


EVALUATE POLYNOMIAL AND DERIVATIVES 

LAGR0690 

LAGR0700 

23 

IF <0A8S(YBAR)-0ABS(XBAR| *1.0-6 7*24,23,25 

LAGR0710 

24 

YBAR=0.0 

LAGR0720 

23 

M = 6 

LAGR0730 


IF(YBAR) 27,26,27 

LAGR0740 

26 

M= 3 

LAGR0750 

2/ 

DO 207 K=NU,N 

LAGR0760 


T=-A(K,K*1 ) 

LAGR0770 


DD 20 7 L - 1 1 M 

LAGR0780 


S * OSIGNI 1 *000 , 3.5DO-DFLOATIL) ) 

LAGR0790 


ssssss - s 

LAGR0800 


M1=L+3*IFIX(SSSS$S) 

LAGR0810 


R=-X8AR*P(L,K >>Y3AR*S*P (MI,K >-DFLOA TIMOD U~ 1 ,3) )*P(L-i ,K) 

LAGR0820 


CO 28 J= NU , K 

LAGR0830 

28 

R = R +P { L , J ) * A I K , J ) 

LAGR0840 


IF. (2)29,32,29 

LAGR0850 

29 

Z*0.0 

LAGR0860 


P( 1 ,NU )= 1 .0- 10*P ( 1 ,NU) 

LAGR 08 70 


I F ( P ( 1 , NU ) >30,30,2 7 

LAGR0860 

30 

IF{N-NU+l) 204,305,204 

LAGR0890 

303 

F -0 • 

LAGR0900 


GO TO 705 

LAGR0910 

204 

F=OFLOAT(K-NUl/OFLOAT(N-NU+I > 

LAGR0920 

203 

CONTINUE 

LAGR0930 


XBAR“XBAR*F 

LAGR0940 


YBAR=YBAR*F 

LAGR0950 


P ( i , NU ) - 1.0 

LAGR0960 


GO TO 27 

LAGR0970 

32 

I F ( N— K >33, 33, 34 

LAGR0980 

33 

T = 1 . 0 

LAGR0990 

34 

IF { T • NE • 0*000 > GO TO 206 

LAGRIOOO 


P(L,KH)=0. 

LAGRIOIO 


GO TU 207 

L AGR 1020 

206 

P ( L , K-f 1 ) = R / T 

LAGR 1030 
LACK 1040 

207 

CONTI NUF 

LAGR1030 


SCALE DOWN 

LAGR1060 
LAGR 1070 


DO 30 K - 1,6 

L AGR 1080 

39 

B ( K ) = 0*0 

LAGR 1090 


DU 33 J = I , M 

LAGR 1 1 00 

33 

HI J)=P( J,N+l ) 

LAGR 1110 


Gl- DABS I B I l ) ) +OAHS ( B ( 4 ) ) 

LAGR 1120 


G2 = 0 A 0 S ( H ( 2 ) ) ♦ 0 A B S ( 6 1 6 ) > 

LAGR 1 1 30 


03= CAP S I B ( 3 ) > t CABS ( H ( 6 > ) 

L AGR 1140 


C = C A B S I ri I I ) } 

LAGR 1150 


DO 36 K=2,M 

LAGR 1160 



n o o o o o 


36 0= OMAX 1 { Dt DABS ( Bt K ) ) ) 

CALL SCALE ( D* H f M i 
IF CGI I 41,41*43 

REMOVE KNOWN ROOTS 

43 Q1R=0.0 
Ql I =0.0 
Q2R=0.0 
G2 I =0 . 0 

1 F C NUQ-NU ) 19 » 2 L » 21 
21 00 44 J=NU,NUQ 

Dl-RTRC JV-XBAK 
D2= RT I ( J ) -Y BAR 
D=Dl**2+02**2 

IF (D.NE. O.ODO) GO Tu 2v 8 

01 = 0 . 

02 = 0. 

GO TO 209 

208 Dl=Di/C 
D2=-D2/D 

209 Q1R=G1R*DI 
Ql I =01 1 +02 
Q2R=Q2R+0l**2-D2**2 

44 02 1=021^2. 000*0 1*02 

FIND SI ANU S2 

19 If ( 8(11 .NE. 0.000) GO TO 210 
T1R = 0. 

GO TO 211 

>10 TIR= H(2)/B(l) 

211 T 1 1 = 0. 

ifiem .ne. o.ooo) go to 212 

T2R = 0. 

GO TO 213 

212 T2R = B(3)/B<2) 

213 T 2 1 = 0 . 

IF C YBAR ) 45,46 , 4 5 
4 3 Dl = B( l )**2*fl ( 4 ) **2 
02 = B < 2 ) * * 2 ♦ B t 5 ) * * 2 
IF 101 • N E . O.OCO) GO TO 214 
T1R = 0. 

Til = 0. 

GO TO 215 

214 T l R = < B t 2 )*B( l)+B( 5)*B(4) )/Dl 
T 1 1 = { 0 ( 5 ) *8 ( l ) - B ( 4 ) * 8 ( 2 ) ) /OX 

213 IF ( 02 .NE. O.ODO) GU TO 315 
T 2-R = 0. 

T 21 = 0. 

GO TO 46 

315 T2R=«6(3)*B(2)+BI6)*B(3))y 2 

T 2 1 = ( B ( 6 ) *B ( 2 ) -B ( 5 )*B ( 3) */ )2 
46 S l R = I 1 R + Q 1 R 
S 1 1 = T 1 1 ♦ C 1 1 

S2R = T 1 R* ( T l R'T 2.R ) - T 1 I * I T 1 1 -T2 I ) - Q2R 
S2l=TlR*( I i I-T2J ) ♦ T 1 1 * ( T LRr-T 2R 1-Q2I 


LAGR1170 
LAGR1180 
LAGR1190 
LAG* l 2 00 
LAGR1210 
LAGR 1220 
LAGR1230 
LAGR1240 
LAGR1250 
LAGR1260 
LAGR 1270 
LAGR 1280 
LAGR 1290 
LAGR l 300 
LAGR 1310 
LAGR 1320 
LAGR 1330 
LAGR l 340 
LAGR 1350 
LAGR 1360 
LAGR 1370 
LAGR 1380 
LAGR 1390 
LAGR1400 
LAGR 14 10 
LAGR 1420 
LAGR 1430 
LAGR 1440 
LAGR1450 
LAGR 1460 
LAGR 1470 
LAGR 1480 
LAGR1490 
LAGR1500 
LAGR 1510 
LAGR 1520 
LAGR1530 
LAGR 1540 
LAGRaFSO 
LAGR l 560 
LAGR1570 
LAGR1580 
LAGR 1590 
LAGR1600 
LAGR1610 
LAGR 1620 
LAGR 1630 
LAGR 1640 
LAGR 1650 
LAGR 1660 
LAGR 1670 
LAGR 1680 
LAGR 1690 
LAGR 1700 
LAGR 1710 
LAGR 1720 
LAGR 17 30 
LAGR 1740 
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o o n 


C FINO THE NEXT ITERATE 

C 

LLY=LLY*1 

D = DABS { XBAR ) +DABS ( YbAR ) 

IF 11*0+7 -D * I DABS ( S IK ) + DAB SIS l I 1 1 I 41,41,42 

41 KARK = 1 

GO TO 100 

42 G=N-NUQ 

4b IF ( YBAR -DABS ( X ) ) 50, 50, 491 
441 IF IYBAR .ME • O.ODO) GO TO 49 
GO TO 216 

49 S 1 1 =S 1 1 ♦ 1 *000 / { 2.0D0 * YBAR I 
S2R=S2R+1.0D0 / { 4.000 * YBAR *♦2 1 

216 G=G-1.000 

50 I F { BL 1 ) 65, 65,66 

65 H = 0.500 * ( G - 2.000 ) 

GO TU 67 

66 H=G- 1.000 

67 DR=H*( C*S2R-S1R**2*S1I**2 ) 

D I = H* I G+ S2 I - 2 . 000* S LR* S II) 

IF (01)53,51 ,53 

51 E l =0.0 

ER*CSCRT ( DABS ( CR ) ) 

I F I DR ) 52, 54, 54 

52 F I -FR 

E R = 0 • 0 
GO TO 54 

53 CALI CX S Q R T < CR ,DI,EK,EI ) 

54 I F ( S 1 R *H R ♦ S 1 I * E I ) 55 ,56, 56 

55 ER=-ER 
E I --E I 

56 D1=S1R+ER 
D2-SI I +E I 

0 = 0 1**2+ D2**2 

IF (C .NE. O.ODO) GO TO 217 
X = 0 • 

Y=C. 

GO TO 218 

217 x=— G*D I/O 
Y=G*D2/D 

218 XBAR=XBAK*X 
YBAR=YBAR*Y 

DELNCW = DABS (X) +DABS ( Y ) 

IF (DEL OLD ..ME. O.ODO) GO TO 219 
RNEW = o. 

GO TO 220 

21 9 RNEW = CCLNEW/ CEL OLD 

22 0 0 = DABS ( XBAR I +DABS ( YBAR ) 

TEST FCR LINEAR CONVERGENCE 

IFELLY-3 ) 6 2 ,6 ? , 57 
57 IF (Df L nEW-DWAXI I 3 . OdO+DELOLD , • 5D0+D ) ) 57 1,571, 570 
570 IF ( BL 1 ) 571,571,5/2 
57? DEL OLD-CAP 
RUL P-3.0 

If ( L L Y - 1 5 ) 14,14,10.0 
8 7 i I F ( RNF W- . 700 *KOL D > 6 2 , 68 f 58 


LAGR 1750 
LAGRi 760 
LAGR 1770 
L AGR 1780 
L AGR 1790 
LAGR1800 
LAGR1810 
LAGR 1820 
LAGRi 8 30 
LAGRi 840 
LAGR 1850 
L AGR I860 
L AGR 1870 
LAGRI 880 
LAGRI 890 
LAGR 1900 
L AGR 19 l 0 
LAGR 1920 
LAGR 1930 
LAGR 1940 
LAGR1950 
LAGR I960 
LAGR 1970 
LAGR 1980 
LAGR 1990 
LAGR2000 
LAGR 20 10 
LAGR 20 20 
LAGR2030 
LAGR2040 
LAGR2050 
LAGR 2060 
LAGR 2 070 
LAGR2080 
LAGR2090 
LAGR 2 100 
LAGR 21 10 
LAGR2120 
LAGR2130 
LAGR 2 l 40 
LAGR2150 
LAGR2160 
LAGR 2 170 
LAGR 2 180 
LAGR 2 1 90 
LAGR2200 
LAGR 2 2 10 
LAGR 22 20 
LAGR2230 
LAGR2240 
LAGR2250 
LAGR 2260 
LAGR2270 
LAGR22 80 
LAGR2290 
LAGR2300 
LAGR2310 
LAGR2320 
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58 

MARK— 3 

LAGR2330 


IF ( DE LNF w- • 00 1 D0*EPS*CAP ) 70,59,59 

LAGR2340 

59 

I F ( BL 1)61,61, 60 

LAGR2350 

60 

X BAR = X BAK-X 

LAGR2360 


Y B AR = YB AR—Y 

LAGR2370 


B L 1 = 0 • 0 

LAGR2380 


GO TO 48 

LAGR2390 

61 

8L1 = U0 

LAGR2400 


GO TO 63 

LAGR24 10 

C 


LAGR2420 

c 

TFST FOR AN EIGENVALUE 

LAGR2430 

c 

I F ( DELNEW-EPS*DMAX I ( D , . OOiDO+CAP) ) 64 ,64 ,63 

LAGR2440 

62 

LAGR2450 

63 

DELOLD=OELNEW 

LAGR2460 


ROLD=RNEW 

LAGR2470 


IF (LLY-15) 23,23,100 

LAGR2480 

C 


LAGR2490 

C 

00 WE HAVE A COMPLEX APPROACH TO A REAL ROOT 

LAGR2500 

c 


LAGR2510 

64 

M ARK=2 

LAGR2520 

70 

BL I = 1 

LAGR2530 


1 F ( YBAR ) 71 , 100,71 

LAGR2540 

71 

IF<G2 *0A8S(YBAR)-Gi) 72,100,100 

LAGR2550 

72 

IF( ONCE) 73, 7.3,1 00 

LAGR2560 

73 

x«0.0 

L AGR2570 


ONCE- 1*0 

LAGR2580 


YBAR=0.0 

LAGR2590 


GO TO 63 

LAGR2600 

C 


LAGR2610 

C 

WE ACCEPT ( XB AR , YBAR ) AS A ROOT 

LAGR2620 

c 


LAGR2630 

100 

NUQ=NUC+1 

LAGR2640 


RTR { NUQ ) = XBAR 

LAGR2650 


IF ( DABS < YBAR )-. 00100 *0ABS(X8AR) >74,74, 75 

LAGR2660 

74 

YBAR=0 • 0 

LAGR26 70 

75 

IF(NUC-NU) 9,76, 9 

LAGR2680 

9 

IF(RTI(NIUQ-n )76,76,77 

LAGR2690 

76 

YBAR=QABS( YBAR) 

LAGR2700 


RTI { NUQ ) =YB AR 

LAGR2710 


GO TO 78 

LAGR2720 

77 

RTI (NUQ) =-DABS( YBAR) 

LAGR2730 

78 

CONTINUE 

LAGR2740 


LLY-O 

LAGR2750 


C AP = DMAX 1 { D» C AP ) 

LAGR2760 


CELOL C- l • 0 

L AGR2770 


R0L'D=1.0 

LAGR2780 


EGSUMI=FGSUMURTR(NUQ) 

LAGR2790 


EGSUM2 = 6 GSUM2 + RTR ( NUQ ) *#2-R T I ( NUQ ) **2 

LAGR2800 


IFINUQ-Nl )80, 101,101 

LAGR2810 

80 

I F ( Y B A R ) 8 3 , 84 ,81 

LAGR2820 

81 

YBAR- -YBAR 

LAGR2830 


GO TO 23 

LAGR2840 

8 3 

I F { NUQ-NIU ) 3 1 , 84 , 31 

LAGR2850 

31 

R T I ( NUQ- 1 ) =. 5UU* CR TI ( NUQ- 1 > -R T I ( NUQ ) ) 

LAGR2860 


RTI (NUQ) =-RT I (NUQ- 1 ) 

LAGR2870 

C 


L AG R 2880 

C 

A N EW TUN ITERATE TOWARDS NEXT ROUT 

LAGR2890 

C 


LAGR2900 
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84 CMC E - 0 . 0 
Z = 0.0 

!F( ( D AB S ( 0 1 R I +DA6 -S ( Q 1 1 ) ) *D- 10000.00 ) 85 , 85 , 14 
65 IF (DABS ( EGSUM1 -SPUR 1 )♦ DABS ( EGSUM2-SPUK2 ) -1 .0-5 *CAP) 15*15,86 
86 DR = B (3) + 2 . 0D0 * { B < 2 > *Q1 R“B ( 5 ) *Q 1 1 > 

CI=B( 6) +2.000*1 B( 2 )*QU+B( S)*QLR) 

D2=DR**2+DI**2 

IF (02 .N€. 0.000) GG Til 221 

YBAR= CABS (Y BAR ) 

GO TO 23 
221 CONTINUE 

XBAR=XBAR-2.0D0*(DR*B(2)+DI*B(5J )/02 
YBAR= CABS ( Y8AR-2. ODO* ( DR *B(5)-D 1*8(2) )/D2) 

GO TO 23 
101 RETURN 
END 


LAGR2910 
LAGR2920 
LAGR2930 
L AGR2940 
LAGR2950 
LAGR2960 
LAGR2970 
LAGR2980 
LAGR2990 
LAGR3000 
LAGR3010 
LAGR3020 
LAGR3030 
t AGR 3040 
LAGR3050 
L AGR 3060 
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SUBROUTINE E I G 3 ( A , N , M , R TR , R T I) 

EIG30010 


IMPLICIT REAL *8 (A-H, U-Z ) 

EIG30020 


EIGENVALUES UF NON- SYMMETR I C MATRICES 

EIG30030 


DIMENSION A( SO, SO) 

EIG30040 


DIMENSION NCI SO) ,RTR{SO) ,RTI (SO) 

EIG30050 


**** DOUBLE PRECISION EIG3 **** 

EIG30060 


TRACE=A{ 1,1) 

EIG30070 


DO 10 1=2, N 

EIG30080 

10 

TRACE=TRACE*A( 1,1) 

EIG30090 


B = 1 • E-7 

EIG30100 


CALL TRING IA,B,N,NC ) 

E I 0301 10 


TRACE=A{ 1,1) 

EIG30120 


DO 11 I = 2 1 N 

EIG30130 

11 

TRACE=TRACE+A( 1,1) 

EIG30140 


NU = 0 

E IG30150 


NV = 0 

EIG30160 

13 

IF C i>"/ -N ) 14, 12, 14 

EIG301 70 

14 

NV=NV+1 

EIG30180 


NU = NV 

EIG30190 

16 

IF (NC(NV) )1S, 17, IS 

£ I G30200 

16 

NV=NV*1 

EIG30210 


GO TO 16 

EIG30220 

1 7 

IF (NV-NU) 19, 18, 19 

EIG30230 

lb 

RTR(NU)=A(NU,NU) 

EIG30240 


RT I (NU ) = 0.0 

EIG30250 


GU TO 13 

EIG30260 

19 

IF (NV-NU-1)20,21,20 

EIG30270 

20 

NP = M I NO ( M, NV ) 

EIG30280 


CALL LASER! A, 1 . D-4 , NP , NU , NV , RTR , R T I ) 

EIG30290 


GO TO 13 

EIG30300 

21 

RR= • SCO* ( A ( NU , NU ) ♦ A ( NV * N V ) ) 

EIG303I0 


El=RR**2~A{ NU,NU)*A(NV,NV)+A ( NU ,NV > *A ( NV , NU ) EIG30320 


$=OSQRT{ OABSI El ) ) 

EIG30330 


I F ( E 1 ) 22 , 23, 2 3 

EIG30340 

23 

R T R ( NU ) = RR +S 

EIG30350 


RT I (.NU ) =0. 0 

EIG30360 


RTR (NV )=RR-S 

EIG30370 


RT I (NV > = 0*0 

EIG30380 

26 

CUNT INUE 

EIG30390 


GO TO 13 

EIG30400 

22 

RTR (NU)=RR 

EIG30410 


RT I (NU )=S 

EIG30420 


RT R ( NV ) = RR 

EIG30430 


RT I ( N V ) = — S 

EIG30440 


GO TO 2:5 

EIG30450 

12 

X = 0 .0 

EIG30460 


CO 24 1=1, M 

EIG30470 

24 

X = X +R TR { J) 

EIG30480 


RETURN 

EIG30490 


END 

EIG30500 
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SUBROUTINE TRINGI A,EPS,N,KOOOFX) 


TRIN0010 


IMPLICIT REAL*8 IA-H, U-Z) 


TRIN0020 

c 

ALMOST TRIANGULAR < HESSENBERG) SUBROUTINE 

TRIN0030 


DIMENSION A{ 50, 50 ) 


TRIN0040 


DIMENSION KOOOFXt 50) 


TRIN0050 

c 

♦*** DOUBLE PRECISION TRING 


TRIN0060 


Ni=N-i 


TRIN0070 


N2=N-2 


TRIN0080 


DO 21 J= 1, N 1 


TRIN0090 


S*0 ABS (AUtJ + in 


TRINOIOO 


Jl=J+i 


TRINOiiO 


J2= J+2 


TRIN0120 


L = Ji 


TR I NO l 30 


N Ji*N- J l 


TR I NOI 40 


IF ( N J 1 ) 15,15,6 


TRIN0150 

6 

CO 12 K=J2,N 


TR I NOi 60 


T*DABS ( A ( J , K ) ) 


TRIN0170 


IFIT-S)12, 12,11 


TRIN0180 

u 

t=K 


TR I NOI 90 

S=T 


TRIN0200 

12 

CONTINUE 


TRIN0210 


IF ( L— J 1 11 3,15,1 3 


TRIN0220 

13 

DO 131 K = 1 , N 


TRIN0230 


T = A IK , J+ 1 ) 


TR I NO 2 40 


AIK, J+1)=A(K,L ) 


TRIN0250 

131 

A ( K , L ) =T 


TRIN0260 

14 

DO 141 K = 1 , N 


TR1N0270 


T = A ( J ♦ 1 , K ) 


TRIN0280 


AlJ+i , K ) =AI L , K ) 


TRIN0290 

141 

A ( L » K ) = T 


TRIN0300 

15 

l F ( S-EPS* 0MIN1I0ABSI A( J, J) ),OABS(A( J + l, J+D) ) ) 16,16,17 

TRIN03 10 

16 

1 = 0 


TRI N0320 

N J 1=0 


TRIN0330 


GO TO 191 


TRIN0340 

17 

T = A ( J , J ♦ 1 ) 


TRIN0350 


DO 18 K= J2 • N 


TRIN0360 


l F C T ) 30,31,30 


TRIN0370 

31 

A 1 J , K ) = 0 • 


TRIN0380 


GO TO 18 


TRIN0390 

30 

AlJ,K)=A|J,K)/T 


TKIN0400 

18 

CONTINUE 


TRIN0410 

181 

DO 20 1=1, N 


TRIN0420 


M= MI NO ( J , 1-2 ) 


TRIN0430 


U=0.0 


TRIN0440 


IF INJi) 19,19,7 


TRIN0450 

7 

DO 8 K= J 2 , N 


TRIN0460 

8 

U=U+A ( K , I ) ♦A ( J , K i 


TRIN0470 

19 

IF (M) 20,20,9 


TRIN0480 

9 

DO 10 K= 1 , M 


TRIN0490 

10 

U = U”A I K , I )*A( J.+ l, K*1 ) 


TRIN0500 

20 

A ( J + 1 , I)=At J + l, I )+U 


TRIN05I0 

21 

KOOOFXt J 1= L 


TRIN0520 

22 

KQOOFX ( N 1=0 


TRIN0530 


RETURN 


TRIN0540 


END 


TRIN0550 
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SUBROUTINE SCALE (D,B,M) 

SCAL0010 


SUBROUTINE SCALE - FOR USE WITH OECK NO* 6140 FORTRAN IV 

SCAL0020 


01 PENSION ft ( 6 ) 

SC AL 0030 


EQUIVALENCE ( G, I G) , ( E, I E ) , t E 1 , IE 1 ) , I GP ,IGP ) , <Q ,IQ) 

SCAL0040 


DOUBLE PRECISION D,B,DP 

SCAL0050 


FMASK = SWL ( 127*24) 

SCAL0060 


F M ASK 1 = SWL (7,21) 

SCAL0070 


Q = SWL ( 1,30) 

SCAL0080 


DP = SNGL ( DABS ( D ) ) 

S CAL 0090 


6 = ANCA ( DP* FMASK ) 

SCAL0100 


IE = IE- IQ 

SCAL0110 


G = ANCA ( DP » FMASK 1 ) 

SCAL0120 


G = SWR ( IG, 21 ) 

SCAL0130 


I G1 ~ I G/2 

SCAL0140 


IF (IGl - 1)21,10,23 

SCAL01 50 

23 

I G 1 = 0 

SC ALO 160 


GO TO 10 

SCAL0170 

21 

IF ( IG r Q.O) I G1 = 1 

SCAL0180 


IGl = IGU2 

SC AL01 90 

10 

El = SWR ( I ABS ( IE), 22) 

SCAL0200 


I E 1 = IEI - IGl 

S CAL 02 10 


IFIE.LT.O. > IE 1 — — I E l 

SCAL0220 


DO 5 I * 1,H 

SCAL0230 

5 

B( I ) ^ B(I )/2. 000**1 El 

SCAL0240 


RETURN 

SC AL 0250 


END 

SC AL 0260 
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SUBROUTINE C X 5 0 R T< A , B , X , Y ) 
IMPLICIT REAL** ( A-H « O-Z) 

C COKPLFX SQUARE RUOT 

F=DMAX 1 1 DABS ( A ) , CABS ( b ) 1 
IF ( F ) 5,7,5 

5 F=F*OSQR T CIA / F ) **2 + (B/F)**2) 

7 IF I A ) 1,1,2 

1 Y=DSQRTI ( F-A ) *.5C0 ) 

I F ( Y ) 8,9,8 

9 X = O. 

GO TO 3 

8 X- * 5 DO * B / Y 
If <X)A,3,3 

A Xs-X 
Y = -Y 
GO TO 3 

2 X=DSQRT I I F+A )* • 500) 

IF ( X I 10,11,10 

11 Y=0 • 

GO TO 3 

10 Y = » 500 * B / X 
3 RETURN 

END 


CXS00010 
CXSQ0020 
CXSQ0030 
CXSQOOAO 
CXSQ0050 
CXSQ0060 
CXSQ0070 
CXSQ0080 
CXSQ0090 
CXSQ0100 
CXSQOi 10 
CXSQOI 20 
CXSQOi 30 
CXSQOI AO 
CXSQOI 50 
CXSQ0160 
CXSQOi 70 
CXSQOI 80 
CXSQOI 90 
CXSQ0200 
CXSQ0210 
CXSQ0220 
CXSQ02 30 
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SUBRUUT I NF AMPL (M f OMEGA, IPOS} 

C SOLVE FUR THE AMPLITUDES AT EACH REQUESTED FREQUENCY. 

C 

COMMON X ( TOO) , Y I 100) , L I 100) , TH ( 100) 

1 XL I 100,3) , YL ( 100,3) » 

2 RAP ANGI 50) , ZGL I 50) , RHUB ( 50) , RT1P I 50) 

3 THHU8 ( 50) , THTIP I 50) , EDCM ( 3,3) 

A RHO , POISSO , YOUNGS , RADGEN , 

5 NGENLI , LINE1 , NEXT I 100,3) , NP , NT , 

6 ELMSMI 6,6) , AMNIN(6,6) , ELBSM(9,9) , ABNIN|9,9) , 

7 SIGMAXI 100) , SIGMAYC 100) , EL ST IF ( 1 8 , 1 8 ) , 


8 

1 TAUXYI 100), ELSSM19 f 9), MEX 1 100,8), IMEX(IOO) 

, AMP (100)AMPL0012 


DIMENSION SM( 50, 50), SKI 50, 50), ROW (50) , IPOS 1 100) 

AMPL001 3 


DO l I = 1,100 

AMPL0014 


AMPII) = 0.0 



FREQ = OMEGA / 6.283185 

AMPL 0015 


N - M - 1 

AMPL0016 


READ 12*1) ( (SKI I « J ) , J = 1 , 50 ) , 1*1,17) 

AMPL0017 


READ (2*2) ( I SK ( I , J ) , J=l,50), 1=18,34) 

AMPLOO 18 


READ (2*3) I ( SK ( l , J ) , J=i,50), 1 = 35,50) 

AMPL0019 


READ ( 2* 43 ) ( I SM ( I , J ) , J = i,50), 1 = 1,17) 

AMPL0020 


READ (2*44)1 (SMI I, J), J = i,50), 1 = 18,34) 

AMPL002 i 


READ (2*45)1 (SMI I, J), J = i,50), 1=35,50) 

AMPL0022 


DO 7 I = 1, N 

AMPL0023 


DO 5 J = 1 , M 

AMPL0024 

5 

S M ( I , J ) = -OMEGA ** 2 * SM ( I , J ) + SK(I,J) 

AMPL0025 

1 

SMI I , M ) = - SMI I , M ) 

AMPL0026 


K = 1 

AMPL0027 

10 

I = K ♦ 1 

AMPL0028 


IF ( ABS ( SM ( K,K ) ) .GT. 1.0E-10) GO TO 30 

AMPL0029 


DO 15 J = I,N 

AMPL0030 


J 1 = J 

AMPL 0031 


IE (ABSISMI J,K) ) .GT. i.OE-10) GO TO 20 

AMPL0032 

15 

CONTINUE 

AMPL0033 


WRITE 16,16) 

AMPL0034 

16 

FORMAT (// 29H AMPLITUDE MATRIX IS SINGULAR) 

AMPL 00 35 


N = -N 

AMPL0036 


RETURN 

AMPL0037 

20 

DO 25 J = 1 , M 

AMPL0038 


ROW I J ) = SMtJl.J) 

AMPL0039 


S M ( J 1 , J ) = SM I K , J ) 

AMPL0040 

25 

= ROW! J) 

AMPL0041 

30 

Z M = SMI I , K ) / S M ( K , K ) 

AMPL0042 


SM( I , K ) = 0.0 

AMPL 004 3 


J = K + 1 

AMPL0044 

35 

S M ( I , J ) = SM { I , J ) - ZM * SM ( K , J ) 

AMPL0045 


IF (J .CQ. N) GO TO 40 

AMPL0046 


J = J ♦ 1 

AMPL 0047 


GO TO 35 

AMPL0048 

40 

SM(|,M) = SM ( I , M ) - ZM * SM ( K-, M ) 

AMPL 0049 


IF (I .EQ. N) GO TO 45 

AMPL0050 


I = I + 1 

AMPL 005 1 


GO TO 30 

AMPLOO 52 

46 

IF IK ,HG- N-i ) GO TO 50 

AMPL0053 


K = K + 1 

AMPL0054 


GO TO 10 

AMPL0055 

50 

ROWIM) = 1.0 

AMPL0056 


ROW IN) = SM I N , M ) / SMI N,N) 

AMPL0057 


AMPLOOOl 
AMPL0002 
AMPL0003 
, AMPL0004 
AMPL0005 
, AMPL0006 
, AMPL0007 
AMPL0008 
AMPL0009 
AMPL0010 
AMPL0011 
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55 

60 


65 


70 


75 


30 


82 


85 

90 


I = N-l 
J = 1*1 
S = 0.0 

5 = $ ♦ SMI I,J) * RQWI J) 

IF (J .EQ. N) GO TO 65 
J = J ♦ i 
GO TO 60 

ROW(I) = t S M 1 l , M ) - S) / $M( l, n 
IF (I .EQ. 1) GO TO 70 
1 = 1-1 
GO TO 55 
CONTINUE 
K = 0 

00 75 I = 2, NP 

IF M -PCS ID .IT. 0) GO TO 75 
K - K ♦ l 
AMPU) = ROW ( K ) 

CONTINUE 

WRITE (6,80 FREQ 

FORMAT {//50X, i2HFRECUENCY * E12.5//48X 
AMX = 0.0 
00 82 I = 2 * NP 

IF l IPOSII) .LT. 0 ) GO TO 82 

IF ( ABSIAMPUU .LE. AMX 1 GO TO 82 

AMX « ABS ( AMP ill ) 

CONTINUE 
00 90 I = 1 ,NP 

IF (I PCS ID .LT. 0) GO TO 90 
AMP I I) - AMP I I) t AMX 
WRITE (6,85) 1, AMP (I) 

FORMAT I 47 X , 15, IOX, El 5.5) 

CONTINUE 

RETURN 

END 


AMP L 005 8 
AMPL0059 
AMPL0060 
AMP LOO 6 l 
AMPL0062 
AMPL0063 
AMP L 0064 
AM PL 0065 
AM PL 0066 
AMPL0067 
AM PL 0068 
AMPL0069 
AMPL0070 
AMPLOO 7 l 
AMPL0072 
AMPL0073 
AMP L 0074 
AMPLOO 75 
AMPL0076 

4HNOOE,16X,9HAMPLITUOE /) AMPL0077 

AMPL0078 
AMPLOO 79 
AMPL0080 
AMPL0081 
AM PL 008 2 
AMPL0083 
AMPL0084 
AMPL0085 
AMP L 0086 
AMPLOO 87 
AMPL0088 
AMP LOO 8 9 
AMPL0090 
AMPL0091 
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10 


15 


20 


2b 


30 

3b 


SUBROUTINE STRESS ( ZCCS, IPOS ) 

SOLVE FOR THE RELATIVE VIBRATORY BENDING STRESSES AT THE CENT RC I D 
CF EACH ELEMENT . 

COMMON X(IOO) , Y ( 1001 * Z(1C0) . TH(lCO) , XLtlCO,3l , YU100*3> 

1 RAPANGI5CI , ZGL ( 50 1 , RHUBI50) , RTIPI50) , THHUBL50) , 

2 THTIPI50) » EDCM (3*31 t RHO # PCISSC , YOUNGS , RADGEN , 

3 NGENLI , LINE l , NEXTUCO f 3I , NP , NT # ELMSM<6,6> , 

4 A MN I N ( 6 , 6 I , ELBSMI 9f 9 ) , ABN IN (9t9) t SIGMAXUOO) , 

5 SIGMAYT ICC) , ELST IFC 18 . 18 ) , TAUXYUOO) t ELSSM9»9) , 

6 MEX I ICO * 8 I • I MEX { TOO ) » AMP! 150) 

CIMENSIGN IPCS(IOO) # ZCOSUCOI , * 6X1 ICO-* ICO) » CKU00.50) , 

1 BC I 100*50) , R6 ( 1 8 * 18) , WL(9) , SIG1U00) * SIG2UOO) 

2 T AUMAX (ICO) , SIGEFF(IOO) 

ECL I VALENCE ( R6tl*l> , El ST IF IT, II 
J = 0 

CO 5 I = 1,NP 

IF ( IPOSt n .LT. C I 60 TO 5 
J = J + 1 
AMP { J ) = AMP(I) 

CONTINUE 


) 


K1 
K2 
00 
K l 
K2 
L ■* 


= -e 

= c 

10 K 
= K l 
= K 2 
K 4 


ldl 

9 

9 


RE AO (2*L> ( ( BM I » J ) , J= i « 100 ) » I-K 1 *K2 I 
RE AC (2*151 IPK( 1GC»J),J=1,1CG) 


K 1 
K 2 
CO 
K 1 
K? 
L 


= -e 
= c 

15 K 
= Ki 
= K 2 
* K 


1,5 

9 

9 

15 


RE AC { 2 ' L ) { (CM I,JI,1 = 1, 1001 , J=K 1 *K2 ) 

R E AC (2*21) ((CKlItJ), 1*1 , 1QC I t J=46, 50 > 
M = NP - NGENLI 
M2 = 2 * M 


CO 30 K - 
XX= l.C / 
B K ( K f K ) 

DU ?C J 
PMK, J ) 

IF ( K - 


1 , M2 
BK ( K , K ) 
l.C 
1 * M2 

BK(K,J> 541 XX 
M2 ) 25,35,25 


M = K 4 1 

DO 30 I = M,M2 
X X= BK U ,K ) 


PK ( I , K ) 

CO 30 J 
RK( I , J > 

LL = M2 
CC 40 I 

M = I 4 1 

CO 40 K “ M,M 2 
XX= BK ( I ,K ) 

PK ( I ,K) = 0 . G 

CO 40 J = 1 , M 2 


0. C 

1 , M 2 

BK ( I , J ) - XX* BK IK > J ) 
1 

1 , LL 


STRS0010 
STRS0020 
STRS0030 
STRS0040 
» ST RS0050 
STRS0060 
STRS0070 
STRS0080 
ST RS0090 
STRS0100 
STRSOllO 
STRS0120 
, ST RS01 30 
STRS0135 
STRS0140 
ST R SO 150 
STRS0160 
STRS0170 
STRS0180 
STRS0190 
STRS0200 
STRS0210 
STRS0220 
STRS0230 
STRS0240 
STRS0250 
STRS0260 
STRS0270 
STRS02 80 
STRS0290 
STRS0300 
STRS0310 
STRS0320 
STRS0330 
STRS0340 
STRS0350 
STRS0360 
STRS0370 
STRS0380 
STRS0390 
ST RS 04 00 
STRS0410 
STRS0420 
STRS0430 
STRS0440 
STRS0450 
STRS0460 
STRS0470 
STRS0480 
S T R S 0490 
STRS0500 
STRS0510 
STRS0520 
STRS0530 
STRS0540 
STRS0550 
STRS0560 
STRS0570 
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AO 


A5 


50 


8MI.J) = BKU,J) 
P = NP - NCENLl 
CP A5 1 = i,P2 


CO A5 J 
BC( I,J) 
CC A 5 K 

ect i.*ji 

CO 5C I 
AHPtH+n 
CC 50 J 


l ,M 
0.0 
1,P2 
BC ( I,J) 
i,M2 
= 0.0 
If* 


EM K * J ) ♦ XX 


- BK ( I » K ) * CK(KvJ) 


* AMP ( J ) 

PO'I SSG**2 ) 


AMP(M4l) = AMP( M4l I + BC(I r J) 

COE F l = YOUNGS / 2. 0 / ( 1.0 
CO 12C I = i,NT 
NEXT ( 1,1) 

NEX T ( 1,2) 

NEXT 1 1,3) 

IFQS(LA) + 

IFOS(LB) + 

IPOS(LC) 4 
XLC = ( XU I » 1 ) 

YLC * < YLtlfl) 

T BAP = ( XL ( 1,2) * YU!,3) 4 ( XUI, 3) 

* XLC ) * T H ( L A ) 4 ( - XL 1 1 , 3 ) * YLC + YL(f,3) 
TH(LB) 4 < XL ( I ,2 ) * YLC I * TH(LC) 

ABS ( T BAR / XL I 1,2) / YLiI*3) ) 


LA 

LB 

LC 

NA 

NB 

NC 


XL ( 1,2) 
YL ( 1,2) 


XU 1, 31 
■YU It 3 ) 


YL( 1,3) 
XLC ) * 
CCEFi * 


) / 3.0 
) / 3.0 

XU I ,2) ) * YLC - 


55 


55 J = 
55 K = 


COE F 
CC 
CC 

ABN IN ( J , K ) 
ABN IM 1,1) 
ABMN12, 3) 
A BN IN ( 2 , 2 ) 
ARNIM A, 1) 
ABNIM A, 3) 
ABMM A , A ) 
ABN IN ( A, 6) 
ABN IN l 5 , 1) 
ABNIM 5, 2) 
APMM 5, 3) 
l 

ABN I N ( 5 * A ) 
ABN I N (5,6) 
ABNIM 5, 7) 
A 9N IN ( 5 , 8 ) 
ABN INI 5 , 9 ) 
AfiN IM 6,1) 
A BN I N ( 6 , 3 I 
A EN I N ( 6 , A ) 
ABN IN ( 6 , 6 ) 
ABNIM 7,2) 
ABNIM 7,5) 
A 8 N 1 N ( 8 , 1) 
ABN IMP, 2) 
ABNIM 8, 3) 


ABN IN ( 6 , A ) = 


1,9 
1,9 

= 0.0 


STRS0580 
STRS0590 
STRS0600 
STRS0610 
STRS0620 
STRS0630 
STRS06A0 
STRS0650 
STRS0660 
STRS0670 
ST RS0680 
STRS0690 
STRS0700 
STRS07 10 
STRS0720 
STRS0730 
STRS07A0 
STRS0750 
STRS0760 
STRS0770 
STRS0780 
STRS0790 
STRS0800 
STR $08 10 
STRS0820 
STRS0830 
STRS08A0 
STRS0850 
STRS0860 
S TRS0870 
STRS0880 
STR $0890 
STRS0900 
STRS 09 10 
STRS0920 


L 


APMM 8, 5) 
ABNIM 8 ,6.) 


1.0 
-I.C 
1.0 

-3.0 / XL ( I , 2 ) / XUI, 2) 

2.0 / XLC I ,2) 

- A BN IN { A , 1 ) 
l.C / XL (1,2) 

3.0 * (XLU, 31**2 - XL t It 2) **2 ) / ( XL( 1,2 )*YL 1 1 1 3) ) **2 STRS0930 

-2.0 / YU 1,3) STRS09A0 

2.0 * (XLC 1,2) - XUI, 3)) * XUI ,3) /XLU ,2)/YUI ,3) STRS0950 

/ Y L ( 1,3) STRS0960 

-3.0 * ( XUI, 3)/ XL (1,2)/ YLUt3))**2 STRS0970 

- ( XU 1,3)/ YL(I,3))**2 / XLU, 2) STRS0980 

3 . C / YL (1,3)/ YL ( I , 3 ) STRS0990 

- 1.0 / YL ( I *31 STRS 1000 

XL(I, 3)/ Y L (I * 3 ) / Y L t 1,3) STRS1010 

2.0 / XL ( l , 2 ) **3 ST RS 1020 

- 1.0 / XLU, 21/ XLU, 2) ST RS 1030 

- ABN IN (6,1) STRS 10 AO 

ABN IN ( 6, 3 ) STRS 1050 

ABN IN ( 6, 3) STRS1060 

- ABN IN ( 6,3) STRS1070 

6.C*XL (1,3) /XL ( I ,2)**3/YLU ,3 >**?*' XLU ,2 )-XL( 1,31) STRS 1080 
2 . C * XLU, 3)/ XLU, 2)/ XLU, 2 1 / YUI,3) STRS1090 

(XLU, 2) - 3.0 * XLU, 3)1 * (XLU, 2) - XL (I ,3) ) / STRSilOO 
( XL 1 1,2 ) * Y L ( I ,3) ) * * 2 STRS 1 i 10 

6. C * XLU, 3) * (XLU, 3) - XLU, 2)) / XLU,2)**3 / STRS1120 
YL( I, i)**2 STRS 1 1 30 

= - 2.0 * XL! 1,3)7 XL I 1,2)/ XUI, 2)/ YU I , 3 ) STRSIIAO 

= X L ( 1,3)4 ( 3.C * XLU, 3)- 2.0 * XLU, 2)) / ( XUI , 2 ) * STRS 1 1 50 
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1 

ABNIN! 8,9) 
ABM N 1 9 , 1 ) 

X 

ABN IN ( 9* 2 ) 
ABN IM9f3) 
l 

ABN INI 9, A) 
i 

ABN IN (9, 5) 

A BN I N I 9 * 6 ) 

1 

ABN INI 9, 7 ) 
ABN IN I 9 » 8) 
ELRSMIi,!) 

1 

2 

ELBSm,2l 

1 

EL6SM( 1,3) 

1 

2 

EL BSP I l, A) 

1 

2 

ELBSM 1 ,5) 

1 

ELBSMI 1,6) 

1 

2 

ELBSM !« 7) 
EL BSP I 1,8) 
ELBSMI 1,9) 
EL BSP I 2, 1 ) 

1 

2 

ELBSPI 2,2) 

1 

2 

ELBSMI 2, 3) 

1 

2 

ELBSPI 2, A) 

1 

2 

ELBSPI 2, 5) 

1 

ELBSMI 2,6) 

1 

2 

ELBSPI 2, 7) 
ELBSPI 2, 8) 
ELBSPI?. 9) 
ELHSPI 3, 11 
ELBSPI ?, 2) 
I 

F L H SP (3,3) 
ELBSPI 3, A ) 


YL I I ,3) )**2 

-i.G / YLI I ,3)/ YL I 1,3) 
2.0 * I 2.0 *XLU»3)**3 


STRS1160 
STRS 1170 

XL ( 1,2)* I 3.0 *XL (I , 3 1**2 $TR$ii80 


- XLC7,2)**2) ) / I XL(1,2)* YL!I,3))**3 
I XL I l * 2 )**2 - XL 1 1 , 3 ) **2 ) / I XL (I ,2 1 ♦ YL(I»3))**2 


STRS1190 
SIRS 1200 


-2.0 * XL I 1,3) * I XL I I , 2 ) - XL I I « 3 ) ) ♦♦2 /XLU,2)**2 / STRS1210 


YLI I, 3 ) **3 STRS1220 

2.0 * XLll,3)**2* I 3.0 * XLU ,2)- 2.0 * XL(I»3)) / STRS1230 
I XL 1 1,2)* YLI I ,3) 1**3 STRS12A0 
I XL I 1, 3 ) / XL (1*2)/ YLI I v 3) ) **2 STRS1250 

2.0 * XL! I, 31**2* I XL M t 2)- XL<I,3J) / XLII, 21**2/ STRS1260 
YLI I, 31**3 ' STRS 1270 
-2.0 / YLI I, 31**3 STRS 1280 

1.0 / YLI I ,31**2 STRS 1290 
-2.0 * PQ I S SO * ABN INI A, l ) - 2.0 * ABNI N I 5 , 1 ) - I 6.0STRS1300 

* PC1SS0 * ABN IN I 6 , 1 1 + 2.0 * ABNI N 1 8 , 1 ) ) * XLC - STRS1310 

6.0 * A 8 N I N I 9 , 1 1 * YLC STRS 1320 
-2.0 * A BN IN (5,21 - 2-0 * ABNIN(8,2) * XLC - I 2.0 * STRS1330 
PCISSC * ABNINI7#?) ♦ 6.0 * ABNI Nt 9, 2) ) * YLC STRS13A0 
-2.C * I POISSO * ABNI N I A, 3) ♦ ABNIN(5,3) ) - 2.0 * STRS1350 
I 3.0 * POISSO * ABN IN (6, 3) ♦ ABNIN18,3) 1 * XLC - STRS1360 

6.0 * ABN IN 19 , 3 ) * YLC STRS1370 
-2.0 * I POISSO * ABN IN I A , A ) ♦ A B N I N I 5 , A ) 1 - 2.0 * STRS 1 3 80 
( 3.0 * POISSO * ABNI N (6,4) + ABN IN 1 8 ,A ) ) * XLC STRS1390 
- 6.0 * ABNIN (9 , A 1 * YLC STRS1A00 
-2.0 * ABN INI 8,5) * XLC - 2.0 * I POISSO * ABNI N 1 7,5 ) STRSIA10 
+ 3.0 * ABN IN I 9, 5 ) ) * YLC STRS1A20 
-2.C * I PO ISSO * ABN IN (A ,6) ♦ ABNIN (5 ,6 ) ) - 2.0 * STRS1A30 
( 3 • C * POISSG * ABNIN ( 6,6) ♦ ABN INI 8,6 ) ) • XLC - STRS1AA0 

6.0 * ABNINI9.6) * YLC STRS1A50 
- 2 . C * ABN INI 5, 7 ) - 6.C * ABNIN(9,7) * YLC STRS1A60 
-2.C * ABNIN! 5,8) - 6.0 * ABNINI9,8) * YLC STRS 1 A 70 
-2.0 * ABN I N 1 5 ,9 ) - 2.0 * ABNIN(8«9) * XLC STRS1A80 
-2.0 * I ABN IN I A , 1 ) ♦ PUISSO * ABN1N!5,1) ) - 2.0 ♦ STRS1 A90 
I 3.0 * ABN IN 1 6,1) + POISSO * ABN IN 18, l) ) * XLC - STRS 1500 
6.C * POISSO * ABNIN 1 9,1) * YLC STRS1510 
-2.C * POISSO * ABNIN 1 5, 2) - 2.0 * POISSO * ABN IN (8 » STRS1520 
2) * XLC - 2.0 * I ABNIN! 7, 2) + 3.0 * POISSO * STRS1530 
ABN IN I 9 , 2 1 1 * YLC STRS15A0 
-2.0 * I ABNIN (A, 3) ♦ POISSO * ABNI N1 5, 31 ) - 2.0 * STRS 1550 
I 3.0 * ABNIN 1 6,31 ♦ PCISSC * ABN INC 8, 3) 1 * XLC - STRS1560 

6.0 * POISSG * A BN I N 1 9 , 3 ) * YLC STRS1570 
-2.C * I ABN IN I A, A ) ♦ POISSO * ABNIN! 5, A) I - 2.0 * STRS1580 
( 3.0 * ABN IN 1 6, A ) + POISSO * ABNIN18,A) ) * XLC - STRS1590 

6.0 * PCISSC * ABN IN I 9 , A ) * YLC STRS1600 
-2.0 * POISSO * ABN IN I 8,5) * XLC - 2.0 * I ABNI N I 7 , 5 ) STRS 1610 

♦ 3 • C * POISSO * ABN I N I 9 , 5 ) 1 * YLC STRS1620 
- 2.0 * I ABN I N I A , 6 1 + POISSO * ABNIN 1 5,6) 1 - 2.0 * STRS1630 
( 3.0 * ABNIN (6, 6) + POISSO * ABNIN!8,6) 1 * XLC - STRS16A0 

6.0 * POISSO * ABNIN! 9,6) * YLC STRS 1650 
-2.C * POISSO * I ABNIN! 5,7) ♦ 3. C* ABNI N (9 , 7 )*YLC ) STRS1660 
-2.C * PulS SO * I ABNIN (5 ,8) ♦ 3. 0* ABN IN I 9, 8 ) *YLC ) STRS 1670 
-2 . C * PO I SSO * I ABN INI 5 ,9) + APN INI 8,9) * XLC ) STRS1680 

2.0 * ABN I N I 8 , 1 ) * ( 1.0 - POISSO ) * YLC STRS1690 
2.C * t i.C - PCISSO ) * I ABM N I 7,2) * XLC ♦ STRS1700 
ABN IN! 8,2) * YLC ) STRS 17 10 

2.0 * ABNI N 1 8 , 3 ) * I 1.0 - POISSO ) * YLC STRS1720 

2.0 * A BN INI 8 , A ) * I l.C - POISSO ) * YLC STRS1730 


STRS 1310 
STRS 1320 
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60 

65 


70 

75 

80 


85 

90 

95 


100 

105 

no 


i 1 5 
120 


125 


E LBSP I 3 , 6 ) 

-ELCSP I 3 ,7 ) 

EL BSP (3,8) 

ELBSPI 3,9) 

CO 60 J = 

CC 6C K = 

ELBSP ( J * K ) 

CO 65 J = 

H(J) - 0.0 

IE t NA .LE. 0 ) GC TO 80 
R EA C (3* LA) R6 

IF C IPEX(LA) .EQ. i ) GO TO 70 
R6 (3,2) = SIN! Rfc I 3 , 3 ) - ARCOSI ZC-GSIM 


I A B N I N ( 7 , 5 ) * XLC ♦ 
* YLC 


El BSP C 3,5) - 2.0 * ( l.C - POISSO ) * 

L ABN IN (8,5) * YLC ) 

= 2-0 * A BN IN (8,6) * I 1.0 - POISSO I 
= 0.0 
- Q 'Q 

= 2.0 * A8NIN<8,9J * ( 1.0 - POISSO ) * YLC 
1,3 
1,9 

= F.L BSP I J ,K ) * CO EE 
1,9 


) ) 


ARCOSI ZCC SI I ) ) ) 


R 6 12,3) 
CO 75 J 
WLIJ) = 

IF ( MB 


R6I 3, 3) 
R6 1 2 , 2 ) 
R 6 1 2 , 3 ) 
CC 90 J 
WLIJ *3) 

i 

IF I NC 


ZCG.SII ) 
ZCCSI I ) 


} ) 
) ) 


R 6 1 3 * 3 ) = COST R6 1 3, 3 ) 

R6I2.2) = R 6 { 3 , 3 ) 

= -R6 1 3,2) 

= 1,3 

AMPINA) * R6t l , J) + AMPIP+NA) * R6(2,J) + AMPIP+M+NA) * 

1 R 6 I 3 » J 1 

.LE, 0 ) GO TO 95 
READ 13' LB) R6 

IF ( I PEX < L 8 ) .EC. 1 ) GO TO 85 
R6 < 3,2) = S IN ( R 6 1 3 , 3 ) - ARCOSI 
COSI R6 1 3, 3 ) - ARCOSI 
R6I3, 3) 

-R6 (3,2) 

1,3 

AMP(NB) * R6I 1,J) ♦ APPIP+NB) * R612.J) + AMPIM + P+NB) * 
1 R 6 I 3 , J ) 

LE. 0 ) GC TO 110 
REAC (3'LC) R6 

IF I IPEX(LC) .EG. 1 ) GC TO ICO 

R6 I 3, 2 ) = $ I N { Rfc ( 3,3 ) - ARCOSI ZCOSM) ) ) 

Rfc I 3,3) = COSI Rfc I 3, 3 ) ~ ARCOSI ZCCSI I ) > ) 

R6I2,2 ) = R6( 3, 3) 

R6 1 2 , 3 ) = -R6 I3, 2) 

CO 105 J * 1,3 

WLIJ+6) = APP (NC) * Rfc I 1 » J ) + APPIP+MC) * R6(?,J) ♦ AMPIP+P+NC) ♦ 
1 R fc { 3 » J ) 

CC 115 K - 1,9 
SIGPAXI I ) = SIGPAXI I ) 

SI G PAY ( I ) = SIGPAYCI) 

T AUXY ( I) = TAUXY ( I ) 

CONTIiNLF 
cn 125 I * i,NT 
TERM ^ I SIGPAXI I) ♦ 

TFRP2 = SCRTI { SICMAXI I ) 

SIGH I ) = TERP1 ♦ TFRP2 
S IG2 1 I ) = TERM1 - TERM 2 

( SICK 1) - S I G 2 I I I ) / 2 • C 
SCR T I SICIII)**? + S I G2 I 1 ) **2 ~ SIGl(I) 


EL B SP I 2 , K ) 
EL BSP I l , K ) 
EL B SP I 3 » K ) 


WL ( K ) 
WL(K) 
WL IK) 


S IGMAYI 1) ) / 2.0 

SIGMAYT I ) )**2 


TAUPAXI I ) 
STGEFf ( ! ) 


/ 4.0 + T AUXY 1 1 ) *-*2 ) 


* SI G2 (I) ) 


JO 
J1 
J? 
J 3 
J 4 


STRS 17 40 
STRS 1750 
STRS 1760 
STRS 1 7 70 
STRS 1780 
STRS 1790 
STRS1800 
STRS 1 8 10 
STRS 1820 
STRS 18 30 
STRS 1840 
STRS l 850 
STRS 1860 
STRS 1870 
STRS 1880 
STRS 1890 
STRS 1900 
STRS 1910 
STRS 1920 
STRS1930 
STRS 1940 
STRS 1950 
STRS i960 
STRS 19 70 
STRS 1980 
STRS 1990 
STRS2000 
STRS 20 10 
ST RS 20 20 
STRS2030 
STRS2040 
STRS2050 
STRS 2060 
STRS 20 70 
STRS2080 
STRS2090 
STRS 2 100 
STRS2110 
STRS2120 
STRS21 30 
STRS 2 140 
ST RS 2 1 50 
STRS2160 
STRS 2 1 70 
STRS 2 l 80 
STRS 2 190 
STRS2200 
SIRS 22 10 
STRS 2 2 20 
ST RS 22 30 
STRS2240 
STRS 2 2 50 
STRS 2 260 
STRS 22 70 
STRS 22 80 
STRS2290 
STRS2300 
STRS 2 3 10 
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130 

135 

lAO 

U5 

150 

155 

160 


165 
1 70 

175 


) .16. BMX ) GO TO 130 


) 


J5 = 1 
J 6 = 1 
AMX = C 0 
BMX = C * U 
CMX ,* C.O 

cmx = 0,0 

EMX = C.C 
FMX * C.C 
GMX = C.O 
CC 160 J = 1 * NT 
IF ( Aes« SIGMAXt J ) 

J 1 = J 

BMX = ABSt SIGMAXt J) 

IF { A e S C SIGMAY t J ) ) .LB. AMX ) GO TO 135 
JO = J 

AMX = ABSt SI.GtfAY.tJ) 

IF { ABS1 TAUXY(J) } 

J2 = J 

CMX = ABSt TAUXY (J) 

IF ( ABS( S I G It J ) > 

J3 = J 

CMX = AH S ( SIGH J ) ) 

IF ( ABSt S I G 2 1 J > ) 

JA = J 

EMX = ABSt S I G2 t J ) ) 

IF t ABSt T At MAX ( J ) 

J 5 = J 

FMX = ABSt TAUMAXt J) 

IF ( ABSt SIGEFF(J) 

J6 = J 

GMX = ABSt SIGEFFt J) 

CONTINUE 


) 

.LE. 


CMX ) GO TO 1 AO 


) 

• LE. OMX ) GO TO 1A5 


•LE. EMX ) GO TO 150 


) .LE. FMX ) GO TO 155 


) 

> .LE. GMX ) GO TO 160 


AMX 

BMX 

CMX 

CMX 

EMX 

FMX 

GMX 

CO 


165 


SI GM AY (JO ) 
SIGMAXt J t) 
TALXYI J2 ) 
SIGH J 3 ) 
SIG21 JA ) 
TAUMAXt J5) 
.SIG.FF.FtJ6) 
J = 1 , N T 


SIGMAYt J) 
S ICMAXt J ) 
TAUXY (J) 
SIC1 (J) 
SIG2 (J) 
TAUMAXt J ) 
SIGEFFt J ) 


S I CM AY ( J } 
SIGMAXt J ) 
TAUXY (J) 
S I G 1 t J ) 
SIC 2 ( J ) 
TAUMAXt J ) 
SIGEFP t J ) 


AMX 

BMX 

CMX 

CMX 

EMX 

FMX 

GMX 


V.R I TE (6,1 70) t I » S IGMAYl I ) ,$IGMA*tI ) , TAUXYt I ) , 
1 TAUMAXt I ) , SIGEFFt M , I = l, NT 

T CRM AT ( M* / / A C X •RELATIVE VIBRATORY BENDING 
1 •FVALUATFC AT CFNTKU IDS 1 // ' ELEMENT SI 
2HAR SHEAR PRIN SIGMA1BAR PR IN SI 

3R FFF. STRESS* / 50 ( AX , I 3» 7E 1 6 • 5 /),*1* / 

A /) ) 

WRITE (6,175) J 0 , AM X , J l , BM X , J2 ,C MX , J3 , DMX , JA ,E 
KIP'MAT t / AX, l 3 » F 1 6 . 5 / A X , I 3 , l 6 X , E 1 6 . 5 / AX, 

1 AX, I 3, A 8 X, £16.5 / A X » 13,6 AX « C 1 6 . 5 / 

2 AX, I 3 , 9 6X , £ 1 6 . 5 j 


STRS2320 
STRS 2 3 30 
STRS23A0 
STRS2350 
STRS2360 
STRS2370 
STRS2380 
STRS2390 
STRS2AO0 
STRS2A10 
STRS2A20 
STRS2A30 
STRS2AA0 
STRS2A50 
STRS2A60 
STRS2A70 
STRS2A80 
STRS2A90 
ST RS 2500 
STRS2510 
STRS2520 
STRS2530 
STRS 2 5 AO 
STRS2550 
STRS2560 
STRS2570 
STRS 2580 
STRS2590 
STRS2600 
STRS 26 10 
STRS 2620 
STRS2630 
STRS26A0 
STRS 2650 
STRS 2660 
STRS 26 70 
STRS2680 
STRS 2690 
STRS 2700 
STRS2710 
STRS2720 
STRS2730 
STRS27A0 
STRS 2 750 
STRS2760 
STRS2770 
STRS 2780 

SIGHT ) 9 S I G2 1 I ) ♦ STR S2790 

) STRS2800 

STRESSES* / A 5 X STRS2810 
GMAYBAR S I GM AXST RS 28 20 

GMA2HAR MAX SHEASTRS2830 

/// 5 0 1 A X * l 3 1 7 E 1 6 • 5 STRS28AQ 


MX 9 J5 t F MX » J6 » GMX 
l 3 * 32 X , E16. 5 / 

A X , I 3 , 8 0 X » E 1 6 • 5 


STRS2850 
STRS 2860 
STRS2870 
STRS2880 
S T RS 2 890 


RETURN 

ENC 


ST R S 29 00 
STRS2910 


i 
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LOGIC START <T ~ _ 

ENTRY ANOA 

_ _ ENTRY ORA 

ENTRY XOR 

_ _1_ " entry com 

ENTRY__SWR 
EN TRY SWL ~ 

" ENTRY I ANOA 

ENTRY IORA_ 

ENTRY I XOR 

ENTRY iCOM 

ENTRY IS WR ” 

ENTRY I SWL 

1_ DC C«AND« 

DC X *03* 

USING ANCA,15 

ANOA STM 2,3*284 13) 

LM 2*3,0(11 

L "2,6(2) 

L 3*0(3) 

NR 2,3 

ST 2,X0 

" 3^ OtXO 

C_ o,x6" _ 

”1 __LM 2,3,28(13) 
BCR IS, 14 



DC 

C * OR • 




DC 

X * 0 3 * 




USING 

ORA, 15 



ORA 

STM 

2,3,28(13) 




LM 

2, 3, 0(1) 




L 

2,6(2) 




L 

3,0(3) 




OR 

2,3 




ST 

2 , XO 




LE 

o,xo 




L 

o,xo 




LM 

2,3,28! 13) 




BCR 

15*14 




DC 

C s XOR 9 




DC 

X * 03® 




USING 

XOR, 15 



XOR 

STM 

2,3,28(13 > 




LM 

2, 3,0(1) 




L 

2,0(2) 




L 

3,0(3) 




XR 

2,3 ~ 




ST 

2, XO 




LE 

o,xo 




L 

o,xo 




LM 

2,3,28113) 




BCR 

15,14 




DC 

C 9 COM ■ 




DC 

X # 03* 




USING 

COM, 15 



COM 

STM 

2,3,28(13) 




LM 

2, 3, 0(1) 




L 

2,0(2) 
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LCR 

2,2 


ST 

2.X0 


LE 

o ? xo 


L 

o,xo 


LM 

2 , 3 ,28( 13) 


BCR 

15,14 


DC 

C •SWR* 


DC 

X * 03* 


USING 

SWR, 15 

SWR 

STH 

2,3,28113) 


LM 

2 , 3,0( i) 


L 

2,0(2) 


L 

3,0(3) 


SRL 

2,0(3) 


ST 

2 ,X0 


LE 

0,X0 


L 

o,xo 


LM 

2,3,28(13) 


BCR 

15,14 


DC 

C # SWL • 


DC 

X * 03 f 


USING 

SWL, 15 

SWL 

STM 

2,3,28(13) 


LM 

2»3»0(l) 


L 

2,0(2) 


L 

3,0(3) 


SLL 

2,0(3) 


ST 

2 , XO 


LE 

0,X0 


L 

0,X0 


LM 

2,3,28(13) 


BCR 

15,14 

XO 

DS 

IF 

1 ANOA 

EQU 

ANDA 

IORA 

ECU 

ORA 

IXOR 

EQU 

XOR 

ICOM 

EQU 

COM 

ISWR 

EQU 

SMR 

I SWL 

EQU 

SWL 


ENC 



i 
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CLOCK START 0 " '' 1 L CL OK OOOO 

MO E9U Q __7_7_ _ 1_I CLOKOOIO 

BRl _ JEQU 1 __ _ CLQK0021 

BR2^ EQU 2 . __ JCLOK0022 

BR_3 EQU 3 _ _ CL0K0023 

BRA EQU A _____ __ CLQK0 02A 

BR5 EQU 5 _ ___ _ _ _ CLQK0025 

8R6 EQU 6 \ __ CL0K0026 

BR7. EQU 7_ __ ' _ __ ___ CL0 K002 7 

BR8 EQU 8 _ CLOKOQ28 

BR9 EQU ? ________ _ CLOK CQ29 

BRIO EQU 10 CL0K0030 

6R11 EQU 11 ~ 1 “ _ CL OK 00 31 

BR12 EQU 12 CLQK0032 ’ 

BR13 EQU 13 CLOK0033 

BRl A EQU 1A _ CL0K003A 

BR15 EQU 15 ' ‘"77 “ ’ _ JCL0K0035 

ENTRY HCLOCK* lCLOCK*SCLOCK»bATE 
USING *,BR15 

H CLOCK SAVE t 1 A , 5 ) „ * * ~ ~ CLOKOIOO 

LR BR1.BR13 CLOKO 103 

LA BRl 3* SAVE “CLOKOlOji” “ 

ST BR13* 8( OtBRl) ' ' ' CLOK0107 

ST BR 1* A S 0»BR13 > _ CLO KOI OO . 

TIME _ 1 CL0 K01 1 0 

L BRl 3* A( 0* BR 13 ) CLOKO 112 

L B_R1 5*16 ( 0 • BR 1 3 ) RESTORE BASE REGISTER _ CL0K0115 

0 BRO* ZFBYT INSURE PROPER SIGN FOR PACKED DIGIT. CLOK0l20 

SJT BROtPTIME TEMP STORAGE FOR PACKED TIME.” ~CL 0k0130~ 

_ __jJNPK _ ZT I ME 1 7 1 » PTI ME (A ) UNPACK TIME TO^ ZONED DECIMAL. CLOKOl AO 

L 8R3 » ZT I HE HOURS AND MINUTES. CL0K0150 

SLDL BR2,16 SHIFT IN ~ CL0K0T6Q~ 

_ ______ SLL 8R2_t 16 JHOURS WITH _ CL0K0170 

0 BR2,BLNK2 _ TRAILING BLANKS. ~ CLOKOI OO 

L BRl *24 t OtBRl 3 ) ' ' CL0K0190 

L BR5 tOI OtBRl I ADDRESS OF FIRST PARAMETER. - CLOK0200 

ST BR2*0 ( 0»BR5 ) SAVE TIME.* ” ~ CL0K0210 

SLDL BR2*16 SHIFT IN ' CLOK022Q 

SLL BR2.16 _ MINUTES WITH _ CLQK0230 

11 O ' BR2*BLNK2 TR A I L I NG BLANK S . CL0K02A0 

L BR5»:aJ0*BRII CL0K02A5 

ST BR2t0I0tBR5l SAVE MINUTES. ^ ‘ CL0K0250 

L BR3*ZTIME+4 MINUTE AND TENTHS “ ~ CLOK0260 

SLDL BR2 * 16 SHIFT IN CL0K0270 

SLL BR2 * 16 SECONDS WITH ' CL0K0280 

0 BR2 »BLNK2 TRAILING BLANKS. '* CL0K0290 

L "" BR5,8( OtBRl I ' CL0K0295 

ST - BR2tOiO,BR5i SAVE SECONDS. CLOK0300 

RETURN fiA,5i,f ' “ CL0KK310 

USING *,BR15" 

ICLOCK SAVE (14*5)*** CLOKOIOO 

' LR BR1,BR13 ' ’ " " CLOKO 

_ __ _LA " BR13 tSA VC ” 7"_1117_71 C LOK O~ 

ST BRl3»8(0tBRl) " ‘ ~ - CLOKO 

ST BR1»4(0,BRT3) - CLQK0 

TIME BIN ~ ~ " ~ " CLQK0330 

L BR13* A( 0>BR 13 ) CL0K0333 

' L BRl5» 1 6C0 *BR13 ) RES TOR E JB ASE REG IS TER 71 7_ ' CLQK033 5 
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LR 

BR1* BRO 


CL0K0337 


SR 

BROtBRO 


CL0K0339 


0 

BR0.F10Q 

CHANGE TO SECONDS FROM HUNDREDTHS 

CL0K0340 


LR 

BROpBRl 


CL0K0350 


L 

BR1 9 241 0 *BR13 ) 

RELOAD ADDRESS OF PARAMETER LIST* 

CL0K0360 


L 

BR5*0t 0*BR1 > 


CL0K0370 


ST 

BR0*0( 0*BR5 ) 

STORE TIME 

CL0K0380 


RETURN C 14* 5 1 *T 


CLOK0390 


USING 

**8R15 



SCLOCK 

SAVE 

( 14*5)*,* 


CLOKOiOO 


LR 

BRl 9 BR13 


CLOKO 


LA 

BR13* SAVE 


CLOKO 


ST 

BR13* 8 ( 0* BR1 ) 


CLOKO 


ST 

BR1 * 4< 0*BR13 J 


CLOKO 


TIME 

BIN 


CL OK 0410 


L 

BR1 3»4{ 0* BR13) 


CL OK 04 20 


L 

BR 1 * 24( 0 * BR13 ) 


CL OK 04 30 


L 

BR5*0(0*BR1) 


CLGK0440 


ST 

BR0*0(0*8R5 ) 

STORE TIME 

CL OK 04 50 


RETURN U4*5J*T 


CL OK 04 60 


USING 

**8R15 



DATE 

SAVE 

114*5),,* 


CLOKOIOO 


LR 

BRi,BR13 


CLOKO 


LA 

BR13® SAVE 


CLOKO 


ST 

BR13,8I0,BR1) 


CLOKO 


ST 

BR1*4C 0*BR13 ) 


CLOKO 


TIME 

DEC 


CL OK 04 80 


L 

BR13t4(0»BRl3> 


CL OK 04 83 


L 

BR 1 5 « 16 ( 0 » BR1 3 ) 

RESTORE BASE REGISTER 

CL OK 048 5 


LR 

BR4*BR1 

LOAD DATE INTO EVEN REGISTER* 

CL OK 0490 


SRDL 

BRA* 16 

SHIFT DAY OF YEAR TO OOD REGISTER. 

CL OK 0500 


SRL 

BR5 * 16 

RIGHT JUSTIFY IT WITH LEADING ZEROES* 

CLOKO 5 10 


SLL 

BR4, 4 

SET-UP YEAR TO ACCEPT A SIGN 

CL OK 0520 


0 

BR5® ZF8YT 

INSURE PROPER SIGN FOR DAY OF YEAR* 

CL0K0530 


0 

BR4»ZFBYT 

INSURE PROPER SIGN FOR YEAR* 

CL0K0540 


ST 

BR4,PYEAR 

STORE YEAR. 

CL OK 05 50 


ST 

BR4*LYEAR 

STORE YEAR 

CLOK0555 


ST 

BR5*PD0FY 

STORE DAY OF YEAR. 

CL OK 05 60 

♦ 


IS THIS LEAP YEAR 

>* 

CL0K0570 


OP 

L YEAR (4) * PFOURI 1 ) 


CLOK0580 


CP 

LYEAR+3U) .ZFBYT+3U) REMAINDER * 0 - MEANS LEAP YEAR 

CL0K0590 


BE 

LPYER 

BRANCH IF LEAP YEAR'. 

CL OK 0600 

♦ 


IS IT DECEMBER 


CL0K0610 

F INOT 

L 

3R4*DEC 12 


CLOK0620 


CP 

POOFY < 4 ) * PK 334 (4 ) 

IS IT DECEMBER* 

CL OK 06 30 


BH 

OECSI 

YES. 

CL0K0640 

* 


IS IT NOVEMBER 


CL0K0650 


L 

BR4.N0V11 


CLGK0660 


CP 

PD0FYI4) ,PK 304(4) 

is IT NOVEMBER* 

CL0K0670 


BH 

NOV SI 

YES 

CL OK 0680 

* 


IS IT OCTOBER 


CL0K0690 


L 

BR4® QCT10 


CLOK0700 


CP 


PD0FYI4) »PK273(4 1 


CL OK 07 10 


BH 


OCTSI 


CL OK 0720 


IS IT SEPTEMBER 


CL0K0730 


BR4* SEP09 


CLOK0740 


CP 


PD0FYI4) ,PK243<4) 


IS IT SEPTEMBER* 


CL0K0750 


BH 


SEPSI 


YES 


CL OK 0760 
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♦ 


IS IT AUGUEST 


CL0K0T70 


L 

8R4.AUG08 


CL0K0780 


CP 

PDOFY <41 »PK212 (4 ) 

IS IT AUGUEST 

CL0K0790 


BH 

AUGS! 

YES 

CL0K0800 

* 


IS IT JULY 

. 

. 

■ 

CL0K0810 


L 

BR4$ JUL07 


CLOK0820 


CP 

PD0FYf4!*PK181«4| 

IS IT JULY 

CL0K0830 


BH 

JULS I 

YES 

CL0K0840 

♦ 


IS IT JUNE 


CLOK0850 


L 

BR4« JUN06 


CLOK0860 


CP 

PDOEY (4) f PK 151(4) 

IS IT JUNE 

CL OK 0870 


BH 

JUNSI 

YES 

CL0K0880 

* 


IS IT HAY 


CL0K0890 


L 

BR4 f HAY05 


CL0K0900 


CP 

PD0FY(4),PK120<4» 

IS IT MAY 

CL0K0910 


BH 

MAYSI 

YES 

CL0K0920 

♦ 


IS IT APRIL 


CL0K0930 


L 

BR4* APR04 


CL0K0940 


CP 

PDOFY { 4 ) t PK090(4) 

IS IT APRIL 

CL OK 09 50 


BH 

APRS! 

YES 

CL OK 0960 

* 


IS IT MARCH 


CL0K0970 


L 

BR4 9 MAR03 


CLOK0980 


CP 

PDOFY ( 4 ) » PK059 ( 4 ) 

IS IT MARCH 

CL0K0990 


BH 

MARSI 

YES 

CL OK 1000 

♦ 


IS IT FEBRUARY 


CLOKIOIO 

FERJA 

L 

BR4»FEB02 


CL0K1020 


CP 

PDOFY (4) »PK03114) 

IS IT FEBRUARY 

CL OK 1030 


BH 

FEBSI 

YES 

CL OK 1040 

♦ 


IT MUST BE JANUARY 


CLOK 1050 


L 

BR4.JAN01 


CL OK 1060 

STDAT 

t 

BR1 * 241 0® BR13 5 


CLOK 1070 


L 

BR5 #0( 0 f>8Rl ) 


CLOK 1080 


ST 

8R4 f 0 1 0 9 BR5 I 

STORE MONTH - MM . 

CLOK1090 


UNPK 

ZTlME*2C2I*PD0FV+2m 

UNPACK DAY OF MONTH. 

CLOKUOO 


L 

BR4® ZTIME 


CLOK 11 10 


SLt 

BR4 « 16 

LEFT JUSTIFY. 

CLOK 1120 


0 

BR4* BLNK2 

PUT IN TRAILING BLANKS. 

CLOK 1130 


L 

BR5«4(0«BR1 I 


CLOK 1140 


ST 

BR^QIOsBRS! 

STORE DAY - DO . 

CL OK 11 50 


UNPK 

ZTIHE+2C2), PYEAR+2 (2 ) 


CLOK 1160 


L 

BR4.ZTIME 


CLOK1170 


SLt 

BR4® 16 


CLOK 1 180 


0 

8R4$BLNK2 


CLOK 11 90 


L 

BR5 »8f OsBRlI 


CLOK 1200 


ST 

BR4 e 0 1 0® 0R5 1 

STORE YEAR - YY . 

CLOK 12 10 


RETURN ( 14t 5 ) »T 


CLOK 1220 

♦ 


ITS LEAP YEAR 


CLOK 1230 

LPYER 

CP 

PDOFY C 4 ),PK 060(41 

IS IT JANUARY OR FEBRUARY 

CLOK 1240 


BNH 

FERJA 

YES 

CL0K1250 


SP 

POOFY ( 4) t PK001 C 4 1 

REDUCE DAYS BY ONE. 

CLOK 1260 


8 

FINDf 

GO FIND DATE. 

CLOK 1270 

* 


CALCULATE DAY OF MONTH. 

CLOK 1280 

DECS! 

SP 

PD0FYI4 ) • PK334 (4) 


CLOK 1290 


B 

STDAT 


CLOK 1300 

NOVSI 

SP 

PDOFYI4 5 ®PK304C 4} 


CLOK 1310 


B 

STDAT 


CL0K1320 

OCTSI 

SP 

PD0FY!4I*PK273(4) 


CL0K1330 


B 

STDAT 


CLOK 1340 
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SEPSI 

SP 

PDOFY (4) *PK243I4J 

CLOK 1350 



B 

STDAT 

CL OK 1360 


AUGSI 

SP 

PD0FYI4 J #PK 212(41 

CLOK 1370 



B 

STDAT 

CLOK 1380 


JULSI 

SP 

PDOFY (4)»PK 181(A) 

CLOK 1390 



B 

STDAT 

CLOK 1400 


JUNSI 

SP 

PD0FY(4),PK151(4> 

CLOK 1410 



B 

STDAT 

CLOK 1420 


MAYSI 

SP 

PDOFY (4)*PK120(4) 

CLOK 1430 



B 

STDAT 

CLOK 1440 


APRS I 

SP 

PDOFY(A) »PK090(A) 

CLOK 1450 



B 

STDAT 

CLOK 1460 


MARS I 

SP 

PDOFY ( 4 ) *PK059(4) 

CLOK 1470 



B 

STDAT 

CLOK1480 


FEBSI 

SP 

PDOFYU),PK031(4) 

CLOK 1490 



B 

STDAT 

CLOK 1500 


JANOi 

DC 

C* 1 * 

CLOK 1600 


FEB 02 

DC 

C® 2 • 

CLOK1610 


MAR03 

DC 

C® 3 * 

CLOK 1620 


APR04 

DC 

C # 4 • 

CLOK 1630 


MAY 05 

DC 

C® 5 • 

CLOK 1640 


JUN06 

DC 

C® 6 * 

CLOK 1650 


JUL07 

DC 

C® 7 9 

CLOK 1660 


AUG08 

DC 

C* 8 9 

CLOK 1670 


SEP09 

DC 

C* 9 • 

CLOK 1680 


0CT10 

DC 

C®10 • 

CLOK 1690 


NOVI 1 

DC 

Cfli * 

CLOK 1700 


DEC 12 

DC 

C ® 1 2 • 

CLOK 1710 


BLNK2 

DC 

C»00 ® 

CLOK 1720 


ZFBYT 

DC 

PL4®0® 

CLOK 1730 


PYEAR 

DC 

PL4® 0® 

CLOK 1740 

■* 

LYEAR 

DC 

PL4 f 0* 

CLOK 1750 


PDOFY 

DC 

PL4®0® 

CLOK 1760 


PK334 

DC 

Pt4* 334® 

CL0K1770 


PK304 

DC 

PL4®304® 

CLOK 1780 


PK273 

DC 

PL4 *273® 

CL0K1790 


PK243 

DC 

PL4®243® 

CLOK 1800 


PK212 

DC 

PL4*212 ® 

CL0K1810 


PK181 

DC 

PL4® 18 l * 

CLOK 1820 


PK151 

DC 

PL4* 151 * 

CLOK 1830 


PK120 

DC 

PL4U20® 

CLOK 1840 


PK090 

DC 

PL4* 090® 

CLOK 1850 


PK059 

DC 

PL4® 059® 

1 CLOK 1860 


PK031 

DC 

PL4®031* 

CLOK 1870 


PK060 

DC 

Pt4®060® 

CL OK 16 80 


PK001 

DC 

PL4®001* 

CL OK 1890 


PFOUR 

DC 

P ®4® 

CLOK 1900 


ZTIME 

DS 

2F 

CLOK 1910 


PTIME 

DS 

IF 

CLOK 1920 


F100 

DC 

F ® 6000® 

CL0K1930 


SAVE 

DS 

18F 

SAVE AREA FOR THIS PROGRAM. CLOK0705 



END 


CL0K0720 
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■■■" : ' " " ... 

. 

— 


ZEROC~- FILL DESIGNATED AREA OF CORE WITH ZERO OR WITH 

ZEROOOOO 

. 

* 


A CONSTANT 

SUPPLIED IN THE CALLING SEQUENCE. 

ZER00010 


* 




ZER00020 


♦ 


CALLING 

SEQUENCE 

ZER00030 



♦ 


CALL 

ZEROC (FROM, TO) 

ZEROOOAO 


♦ 



OR 

ZER00050 



♦ 


CALL 

ZEROC (FROM, TO, CONST) 

ZER00060 


♦ 




ZER00070 


♦ 


WHERE 

-FROM- IS THE STARTING ADORESS 

ZER00080 



* 



TO-FINAL ADDRESS TO BE CLEAREO 

ZER00090 


* 



CONST-THE CONSTANT CORE IS TO BE 

ZER00100 


♦ 



FILLED WITH. IF NOT SUPPLIED 

ZEROOUO 


♦ 



IN CALLING SEQUENCE, CORE 

ZER00120 


♦ 



WILL BE FILLED WITH ZEROES. 

ZER00130 


♦ 




ZER001A0 


puZEftO 

START 

0 


ZER00150 


BRO 

EQU 

0 

BASE REGISTER 0 

ZER00160 


BRi 

EQU 

1 


ZER00170 


BR2 

EQU 

2 


ZER00180 


BR3 

EQU 

3 


ZER00190 


BRA 

EQU 

A 


ZER00200 


BR5 

EQU 

5 


ZER00210 


BR6 

EQU 

6 


ZER00220 


BR7 

EQU 

T 


ZER00230 


BR8 

EQU 

8 


ZER002A0 


BR9 

EQU 

9 


ZER00250 


BRIO 

EQU 

10 


ZER00260 


BRll 

EQU 

11 


ZER00270 


BR12 

EQU 

12 


ZER00280 


BR13 

EQU 

13 


ZER00290 


BR1A 

EQU 

1A 


ZER00300 


BR15 

EQU 

15 


ZER00310 


* 




ZER00320 



ENTRY 

ZERO 


ZERO 0325 



USING 

*,BR15 


ZER00340 


ZERO 

SAVE 

< 1A* 12 J t-t* 


ZER00330 



ST 

BR13*SAVE+A 


ZER00350 


- - - • 

LA 

BRIO? SAVE 


ZER00360 



ST 

BRIO, 810, BRI3) 


ZER00370 



L 

BR3*0t0*BRl J 


ZER00390 



L 

BR4»-4( 0»BR1 ) 


ZEROOAOO 



N 

BR3.BIGAD 

INSURE ADDRESS ONLY. 

ZER00A10 


. 

N 

BRA? B 1 GAD 

INSURE ADORESS ONLY. 

ZER00420 



CLR 

BR3*BRA 

1ST ARG. LESS THAN 2ND ARG. 

ZER00430 



BNL 

SWITCH 

NO, THEN SWITCH REGISTERS. 

ZER00440 

■ 

MODE! 

TM 

4(BR1 ) ,X*80* 


ZER00470 



BZ 

NTZRO 

"MORE" ARGUMENTS. 

ZER00A80 


MODE 

A 

BR4,F0RBT 

YES, CALCULATE BYTES TO BE CLEARED. 

ZER00A50 



SR 

BRA?BR3 

BRA EQUAL NO. OF BYTES. 

ZER00A60 


MORE 

G 

BRA? TW056 

OVER 255 BYTES TO CLEAR 

ZER00500 



BL 

LESTN 

YES 

ZER00510 



S 

BRA?TW056 

REDUCE BY 256 

ZER00520 



L 

BR5?TW056 


ZER00530 


NONE 

S 

BR5 ?TWO 


ZER005A0 



STC 

BR5,M0VE*1 


ZER00550 


MOVE 

XC 

0(0, BR3) , 0( BR3 ) 


ZER00560 



A 

BR3? TW056 


ZER00570 



LTR 

BRA?BRA 


ZER00580 
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BC 

2, MORE 

ZER00590 

RETRN 

RETURN (14,12). T 

RESTORE AND RETURN ZER00600 

LESTN 

LR 

BR5.BR4 

ZER00610 


LA 

BR4.0 

ZER00620 


B 

MONE 

ZER00630 

SWITCH 

LR 

BR5.BR3 

ZER00640 


LR 

BR3.BR4 

ZER00650 


LR 

BR4.BR5 

ZER00660 


B 

HODE1 

ZER006T0 

NTZRO 

L 

BR 6 1 8 ( 0, BR1 ) 

ZERO 06 80 


L 

BR6,0( 0, BR6 ) 

ZERO 06 85 

NTZRI 

ST 

BR6 , 0( 0.8R3) 

ZER00690 


CR 

BR3.BR4 

ZER00700 


BE 

RETRN 

ZER00710 


A 

BR3, FORBT 

ZER00720 


B 

NTZRI 

ZER00730 

SAVE 

DS 

18F 

ZER01000 

BIGAD 

DC 

X *OOFFFFFF * 

ZER01010 

FORBT 

DC 

F"4* 

ZERO 1020 

TW056 

DC 

F *256* 

ZER01030 

TWO 

DC 

F • 1 * 

ZER01050 


END 


ZER09990 
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